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ABSTRACT 


The cost of software development could be reduced if relevant reusable software 
components could be retrieved efficiently. The few libraries currently in existence have 
no standard method for selecting components germane to the intended application. This 
thesis focuses on the actual formation and population of library components for an 
improved software library model proposed in [Ref. 1]. This library would provides the 
codes for users to implement the desired system in CAPS environment. 

The work reported here consists of: identifying candidate reusable components 
from the Booch Ada Library - by manually inspecting over 500 components; converting 
the components into a CAPS-compatible format based on the Prototyping System 
Description Language (PSDL) via Ada-PSDL converter program; creating algebraic 
specifications to match the semantic description of each component manually; and 
manually organizing the library into a data structure based on the multi-level filtering 
concept. 

This work provides (1): the base and guidelines for the (a) criteria for a reusable 
component; (b) process of inspecting and importing components into CAPS reusable 
component library; (2): 75 reusable components to be released with CAPS 95 and used to 
test the user interface for retrieval via multi-level filtering. The process of populating 
reusable components is time intensive due to various manual processes. Inspecting and 
converting each component sometimes takes up to an hour for each. Current tools 
available can be rewritten, i.e. the PSDL-Ada converter, to fully automate this process in 
accordance with the base and guidelines. 
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I. INTRODUCTION 


The need for code reuse has not been addressed adequately in both the academic 
and business world. In the business world, most organizations appear to offer primitive 
incentives to encourage a culture of reuse. However, very few organizations explicitly 
encourage programmers to reuse code, or to write code that is reused. Reuse is preached 
more often than it is practiced. In the academic world, the word has been used but the 
teaching and the practices are also hmited. 

One of the reasons for this is the lack of methods for effectively finding the 
components needed for each application and lack of component libraries organized to 
support such methods. With the current trend of software development, prototyping tools 
seem to be the key for rapid developing applications, going from design to actual 
implementation with executable code. This idea of reusable code is instrumental to this 
prototyping concept. The Department of Defense has long endorsed a programming 
language that is rigid in structure, for safety of operation and most important of all the 
reusability of codes. Ada is the standard language of the DOD culture. The purpose of 
this thesis is to provide a library of reusable Ada components for the Computer Aided 
Prototyping System (CAPS), an ongoing research project at the Naval Postgraduate 
School. 

A. WHY REUSE? 

Each year, billions of dollars are spent on computer software. Much of this effort 
is spent on creating and testing new source code. In order to save money, increase 
productivity, and improve reliability, the Department of Defense is constructing 
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repositories of reusable software components that can be used across applications. A 
great percentage of a typical program is composed of potentially reusable code [Ref. 1] 
and [Ref. 2]. It is desirable to make use of existing code whenever possible. This action 
can significantly reduce the amount of time to develop the software. With prototyping 
software such as CAPS, reusable code can enhance the process of rapid application 
development. 

This approach can be summarized as follows: 

• Cost savings. 

• Early payback. 

• Manpower savings. 

• Technology leverage and risk mitigation. 

• Reliability. 

B. COMPUTER AIDED PROTOTYPING SYSTEM 

The Computer Aided Prototyping System is a software engineering tool for 
developing prototype models of hard real-time embedded systems [Ref. 3] and [Ref. 6]. 
It is useful for requirements analysis, feasibility studies, and the design of large embedded 
systems. CAPS is based on the Prototype System Description Language (PSDL), which 
provides facilities for modeling timing and control constraints within a software system 
[Ref. 4]. It is a development environment, implemented in the form of an integrated 
collection of tools, linked together by a user-interface as shown in Figure 1 [Ref. 5]. 
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Figure 1. CAPS Functionality Overview Diagram 

The library collected in this thesis is part of the Software Base component of the 
CAPS functionality. 

C. ORGANIZATION OF CHAPTERS 

Chapter n reviews the basic concepts and terms relevant to the current research of 
CAPS and its implementation. Chapter IH focuses on the implementation of the database 
component of CAPS and the data structure and retrieval method for these reusable 
components. Chapter IV concludes the research and discusses the user interface of the 
software base component of CAPS. 
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n. BACKGROUND AND PREVIOUS RESEARCH 


This chapter describes some technical background about CAPS to include PSDL. 
Characteristics of reusable components and methods of retrieval are the two primary 
topics of this section. Various previous research and current systems are also discussed. 

A. CAPS DESIGN AND COMPONENTS 

CAPS is an integrated environment aimed at rapid prototyping hard real-time 
embedded systems [Ref. 5] and [Ref. 6]. CAPS tools include an Ada Compiler, Design 
Database, Graphic Editor, Syntax Directed Editor, Software Base, Static Scheduler, 
Dynamic Scheduler, and Translator as shown in Figure 1. Each of these components 
provides specific functions in the development of the software. 

B. PSDL 

PSDL is a text and graphics based language designed to express the specifications 
of real-time systems. It is based on a graphic model of vertices and edges, in which the 
vertices represent operators, or software processes, and the edges represent the conceptual 
flow of data from one operator to another. Each vertex and edge may have associated 
timing constraint, and the vertices may have associated control constraints. 

Formally, the model used is that of an augmented graph, G = (V,E, T(v),C(v)) 
where G is the graph, V is the set of vertices, E is the set of edges, T(v) represents the 
timin g constraints for the vertices, and C(v) represents the control constraints for the 
vertices. 

Conceptually, PSDL operators may contain other operators to support the 
principle of abstraction. Effectively, the prototype may be expressed as a flat graph, or a 
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one level graph containing all the atomic operators and their streams. An atomic operator 
is one that is implemented in a programming language, vice a composite operator 
consisting of other operators and streams. 

For example, the following diagram shows a PSDL prototype: 



Figure 2. Example of PSDL Graph 

Figure 2 represents an operation modeled by the Operator A that accepts one item 
from Stream I, it performs some operation on the data, and outputs Stream O. The 
Maximum Execution Time (MET), this is the maximum possible time the operator may 
take to execute the task, defined as 400 milliseconds. 

Operator A can further be decomposed as shown in Figure 3 below: 



Figure 3. Decomposition of Operator A 
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Operator A is a composite operator, while Operator A1 and Operator A2 are 
atomic operators, implemented in Ada or some other language. The timing and control 
constraints on these atomic operators must be consistent with those of their parent 
operator. In a single processor the combined METs of these atomic operators cannot be 
greater than their parent. Operator A is really not needed for implementation of this 
prototype; it serves as an abstraction of the functionality of the children operators. More 
information about PSDL can be founded in [Ref. 8] and [Ref. 9]. 

C. OBJ3 AND ALGEBRAIC SPECIFICATION 

OBJ3 is implemented in Common Lisp, and is based on ideas from order sorted 
equational logic and parameterised programming. OBJ3 provides mixfix syntax (prefix, 
suffix, and infix), flexible subsorts (subtypes in Ada language), parameterised modules, 
views, and most important term rewriting modulo associativity, commutativity, and 
identity. OBJ was originally designed in 1976 by Dr. Goguen [Ref. 10]. 

In OBJ3, an algebraic specification of objects consists of two parts: a signature 
and a set of axioms. The signature defines the sorts (or types) being specified, the 
operation symbols, and the axioms define their functionality in an object. The signature 
is denoted as (S, E) where S and E are a sort set and an operation symbol set, 
respectively. The axioms are expressed as equations describing the semantics of an 
object. 

D. BASSE DIAGRAM 

A Basse diagram is a graphical representation of a partial ordering relation, for 
which the following properties hold: 
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o 


reflexive 


° anti-symmetric 

° transitive 

For example: the Hasse diagram for ({1,2,3,4} <) is shown in Figure 4 below. 



Figure 4. Constructing the Hasse Diagram for ({1,2,3,4},<) 

This relation is called partial ordering. In Figure 4(a), the arrows indicated the 
relation among the members, since all members hold the reflexive property, the circle 
loops can be eliminated as shown in Figure 4(b), furthermore, since it is a partial 
ordering, all arrows implied by transitivity can be removed, as shown in Figure 4(c). This 
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concept can be extended to partition the software base, in which profile codes define 
partitions that are represented as a Hasse diagram. 

E. PROFILE MATCfflNG 

The computation for parameter matching would be very expensive if it was 
necessary to try all possible combinations of functions and data types with those 
components. For example, if a query has a function f: AAB -> B and a component has a 
function g: BA -> A, these two functions cannot be possibly be matched, thus there is no 
need to compute this combination. The purpose of profile matching is to speed up 
parameter matching. Profile matching is actually an efficient approximation of signature 
matching. A profile is a sequence of numbers that describes how data types are 
associated with an operation. It is defined as follows [Ref. 1]: 

° The first integer is the total number of occurrences of sorts (data types). 

° If the total number of sort groups, N > 0, then the second to (1 + N)* integers 
are the cardinalities of the sort groups, in descending order. 

® The (2 + N)*** integer is the cardinality of the unrelated sort group. 

" The (3+ N)* integer is: 

0 if the value sort is different from any of the argument sorts; and 

1 if the value sort belongs to some sort group. 

Sort groups are bags consisting of two or more sort occurrences from the rank of the 

operation that are related under the relation =, which is the transitive- 

symmetric closure of the ordering < on sorts. 

Unrelated is a set of all sort occurrences that are not in any sort group. 
sort group 
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For example: 


Operation 

Profile Code 

“> A 

110 

AB->C 

330 

AA->B 

3210 

ABBCA -> C 

622201 

CCAAB->B 

622201 


Table 1. Example of Profile Code 
F. CHARACTERISTICS OF A REUSABLE COMPONENT 

A reusable software component should exhibit the best characteristics of any good 
piece of software. Specifically, it should be: 

• maintainable 

• efficient 

• reliable 

• understandable 

and of course, correct. However, there are some important characteristics specific 
to reuse. They should have the following major characteristics: 

• generality 

• definiteness 

• transferability 

• retrievability 

• sufficiency 

• completeness 

• primitiveness 
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Generality and Definiteness: for example, a component supplying elementary 
real functions such as max, min, floor, and ceiling is a good candidate for reusability, 
because these operators are well understood and are applicable to a wide range of 
problems; this address the issue of definiteness. However, to facilitate its reuse, we must 
take care to construct such a component independent of the peculiarities of any 
application, for example, the representation of floating-point numbers. Ideally, we should 
factor out such dependencies and achieve generality. The Ada language has a mechanism 
to implement this characteristic, namely, generics and instantiation. 

Transferability and Retrievability: primarily dealing at the level of source code, 
not object code. Writing a component as an Ada generic package facilitates 
transferability, for here we have a mechanism that can capture many of the relevant parts 
of an abstraction. However, the management of a library with a large number of 
components can be a great concern. The larger the number of components the higher the 
cost of finding a matching component. 

Sufficiency: the component captures enough characteristics of the abstraction to 
permit meaningful interaction with the object. 

Completeness: the component interface captures all characteristics of the 
component. Whereas sufficiency implies a minimal collection of meaningful operations, 
a complete set of operations is one that covers all aspects of the underlying abstraction. 
For example, the abstraction of a set includes the notion of cardinality. It is not necessary 
to include an operation that returns the cardinality of a set; we can interact with a set 
without this capability. However, we should include this operation to enhance the 
completeness of the abstraction. Completeness is a subjective measure and in fact can be 
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overdone. Supplying all meaningful operations for a particular abstraction is not only 
overwhelming for the user, but generally unnecessary, since many high-level operations 
can be composed from low-level ones. For this reason. It is suggested that component 
operations be primitive. 

Primitiveness: operations that can be implemented only with access to the 
underlying representation of the object. Thus, adding an item to a set is primitive, 
because there is no other way to implement this operation unless the underlying 
representation is visible. However, adding four items to a set is not primitive since it can 
be implemented with the adding one item iteratively [Ref. 11]. 

G. SOFTWARE LIBRARIES 

1. Asset Source for Software Engineering Technology (ASSET) 

ASSET is a software reuse library and reuse information exchange available to 
software developers in government, industry, and education. ASSET is sponsored by 
ARPA's STARS (Software Technology for Adaptable, Reliable Systems) Program to 
serve as a national resource for the advancement of software reuse across the DoD. The 
ASSET library, located in Morgantown, WV, is connected to the Internet allowing world¬ 
wide access to reusable software assets. ASSET'S goals are to create a focal point for 
software reuse information exchange, to advance the technology of software reuse 
processes and to provide an electronic marketplace for reusable software products, and 
stimulate a national software reuse industry. 

2. Reusable Ada Package for Information System Development (RAPID) 

The RAPID project is an ongoing effort in the DoD. The objective of RAPID is 

to provide software engineers with quick access to reusable Ada packages in the 
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information system domain. The system performs reusable component classification, 
storage and retrieval. 

3. Common Ada Missile Package (CAMP) 

The CAMP project is also sponsored by the DoD to create a software engineering 
system of reusable software library of components. The system is directed toward 
software for missile systems and uses Ada language for its reusable components. 

4. Operation Support System (OSS) 

The OSS is an ongoing project aimed at developing and integrated software 
engineering environment. The system is being developed at the Naval Ocean System 
Center. One of the goals of the project is to establish a Naval software library of reusable 
software components. 

H. METHODS OF RETRIEVAL 

1. Keyword Search Method 

This is the most crude method, however simplest of all. There is no data structure 
in storing these components. The user, in essence, is using a primitive grep UNIX 
command to search for a word that associated with a component. The useful components 
found by this method is extremely poor when the number of components in a library is 
large since the set of retrieved components is relatively large. This requires the user to 
browse through all the found components and decide which of the components is 
appropriate for usage. There is no way of placing the S 5 mtactic and semantic information 
in this method. However, from informal survey of current progranuners in the private 
industry, this method is very popular. This may not be a surprise due to the fact that there 
is no standard in retrieving reusable components. 
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2. Artificial Intelligence Methods 

Artificial Intelligence methods include [Ref. 9] and [Ref. 10], and some recent 
work by Henninger [Ref. 14], which uses a knowledge base and statistical information to 
retrieve reusable components, based on keyword search from texts describing the 
components. However, because the characterization of the component behavior is 
completely informal, the behavior is unpredictable [Ref. 15]. 

3. Multi-Level Filtering Method 

This method is proposed in [Ref. 1], in which a combination of retrieval processes 
are used. The process is represented as follows: 
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Figure 5. Model for the Multi-Level Filtering Process 
In this method, search is organized as a series of increasingly stringent filters on 
candidate components. We first filter components by comparing their signatures with 
that of the query. This is accomplished by signature matching, which looks for maps that 
translate the type and function symbols of the query into corresponding type and function 
symbols of candidate components. A first stage of signature filtering can compare pre¬ 
computed syntactic profiles of components with the profile of the query. These profiles 
are special data structures that support an efficient approximation of signature matching. 
The key property of a profile is that two operation signatures cannot have a syntactic 
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match unless their computed profiles are equal. Signature matches can be partial, in that 
only part of the functionality the user seeks may actually be available. The profile of an 
abstract data type is a bag containing the profile codes of its operations. In a partial 
signature match, a subset of the query profile is contained in the stored component’s 
profile. Traditional search methods, such as keyword search, could also be used as early 
filters. Profile matching should be followed by full signature matching. 

Semantic filters rank components by how well they satisfy the equations in the 
query. In this process, equations that are logical consequences of the query specification 
are translated through the signature matches into equations whose proof is attempted in 
the candidate specifications. This whole process can be made iterative. 
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III. DESIGN AND CONCEPTS 


A. BOOCHLffiRARY 

The Booch library divided into three categories: data structure, tools, and 
subsystems. A data structure is a component that denotes an object or class of objects 
characterized as an abstract state machine or an abstract data type. A tool is a component 
that denotes an algorithmic abstraction targeted to an object or class of objects. A 
subsystem is a component that denotes a logical collection of cooperating structures and 
tools. Each category is further divided into subcategories as shown in Figure 6 below. 


Reusable 

Software 

Components 



Figure 6. Booch Library 
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Monolithic the structure is always treated as a single unit and that individual parts of 
the structure can not be manipulated. 

Polylithic the structure is composed of individual parts that can be manipulated. 

There are over 500 components in the Booch library in many different forms. It 


often happens that there is a software part that we want to reuse, but it is not exactly in 
the light form [Ref. 16]. Figure 7 below presents the forms of reusable software 
component that have been found to be common across many applications [Ref. 11]. 



Urananaged 

Managed 


Controlled 


Managed 

Unmanaged 

Managed 

Managed 

Uiunanaged 

Managed 

Managed 

Unmanaged 

Managed 

Managed 


Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 

Noniterator 

Iterator 


Figure 7. The forms of a reusable software component 
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Sequential 


Guarded 


Concurrent 


Multiple 


Bounded 

Unbounded 

Unmanaged 

Managed 

Controlled 

Noniterator 


The semantics of an object are preserved only in the presence of one 
thread of control for each instance of the type. 

The semantics of an object are preserved in the presence of multiple 
threads of control, if mutual exclusion is enforced by all clients of the 
object. 

The semantics of an object are preserved in the presence of multiple 
threads of control, and mutual exclusion is enforced by the object itself. 
Access by multiple clients is sequentialized. 

The semantics of an object are preserved in the presence of multiple 
threads of control, and mutual exclusion is enforced by the object itself. 
Multiple simultaneous readers are permitted, but writers are 
sequentialized. 

Denotes that the size of the object is static. 

Denotes that the size of the object is dynamic. 

Automatic garbage collection is the responsibility of the underlying run 
time system and compiler. 

Garbage collection is provided by the component itself, and the type is 
used only by a single task. 

Garbage collection is provided by the sequential component itself even if 
the type is used by multiple tasks.* 

An iterator is not provided for this object. 


' Sequential controlled means several tasks can each have a private instance of the type. 
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Iterator An iterator is provided for this object. 

Together, these forms offer a total of 26 meaningful combinations. The Appendix 
lists the imported components. 

The components in the library conform to the following file name convention: 


assuming the file name of the component is stackssbmn. 


Description 

File Name 

Ada specifications 

vstackssbmn.a 

Ada implementation 

bstackssbmn.a 

PSDL 

vstackssbmn.psdl 

OBJ3 specifications 

vstackssbmn.obj 

Profile code 

vstackssbmn.code 


Table 2. Example of file name convention 
There are 75 components imported into this library. These components are the 
samples of each of the data structure components in the Booch library. This should give a 
broad base number of the components for the reusable components. 

B. POPULATING PROCESS 



Figure 8. Populating Process 
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Components must be manually inspected for reusability criteria listed in Chapter 
n. In the CAPS system, a PSDL specification is an integrated part of a reusable 
component. By adding procedure versions of functions, PSDL specifications can be 
readily generated by a converter written by [Ref. 17]. 

Each step of the populating process, shown in Figure 8, is illustrated in this 
section by an example. An example of the first step, adding procedure/function 


replacement, follows: 

SPECIFICATIONS 


generic 

type Item is private; 

package Stack_Sequential_Bounded_Managed_Iterator is 


type Stack(The_Size : Positive) is limited private; 


procedure 

Copy 

(From_The_S tack 

in 


stack; 


To_The_Stack 

in 

out 

Stack); 

procedure 

Clear 

(The_Stack 

in 

out 

Stack); 

procedure 

Push 

{The_Item 

in 


Item; 


On_The_Stack 

in 

out 

Stack); 

procedure 

Pop 

(The_Stack 

in 

out 

Stack); 


modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_E<iual (Left : in Stack; 

Right : in Stack; 

Result : out Boolean); 

procedure Depth_Of (The_Stack : in Stack; 

Result : out Natural); 

procedure Is_EiDpty (The_Stack : in Stack; 

Result : out Boolean); 

procedure Top_Of (The_Stack : in Stack; 

Result : out Item); 


end of modification 


function Is_Equal 
Boolean; 


(Left 

Right 


in Stack; 
in Stack) return 


function Depth_Of 
Natural; 


(The_Stack : in Stack) return 
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function Is_Empty (The_Stack : in Stack) return Boolean; 

function Top_Of (The_Stack : in Stack) return Item; 

generic 

with procedure Process (The_Item : in Item; 

Continue : out Boolean); 
procedure Iterate (Over_The_Stack : in Stack); 

Overflow : exception; 

Underflow : exception; 

private 

type Items is array(Positive range <>) of Itern; 
type Stack(The_Size : Positive) is 
record 

The_Top : Natural := 0; 

The_Items : Items(1 .. The_Size); 

end record; 

end Stack_Sequential_Bounded_Managed_Iterator; 

IMPLEMENTATION 

package body Stack_Sequential_Bounded_Managed_Iterator is 

procedure Copy (From_The_Stack : in Stack; 

To_The_Stack : in out Stack) is 

begin 

if From_The_Stack.The_Top > To_The_Stack.The_Size 

then 

raise Overflow; 

else 

To_The_Stack.The_Items(1 .. 

From_The_S tack.The_Top) : = 

From_The_Stack.The_Iterns(1 .. 

From_The_Stack.The_Top); 

To_The_Stack.The_Top := From_The_Stack.The_Top; 
end if; 
end Copy; 

procedure Clear (The_Stack : in out Stack) is 
begin 

The_Stack.The_Top := 0; 
end Clear; 

procedure Push (The_Item : in Item; 

On_The_Stack ; in out Stack) is 

begin 

On_The_Stack.The_Items(On_The_Stack.The_Top +1) := 

The_Item; 

On_The_Stack.The_Top := On_The_Stack.The_Top + 1; 
exception 

when Constraint_Error => 
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raise Overflow; 
end Push; 

procedure Pop (The_Stack : in out Stack) is 
begin 

The_Stack.The_Top := The_Stack.The_Top - 1; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

— modified by Tuan Nguyen 

replacing procedures with functions 

procedure Is_Equal (Left : in Stack; 

Right : in Stack; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Xs_Equal; 

procedure Depth_Of (The_Stack : in Stack; 

Result : out Natural) is 

begin 

Result := Depth_Of(The_Stack); 
end Depth_Of; 

procedure Is_Eii^ty (The_Stack : in Stack; 

Result : out Boolean) is 

begin 

Result := Is_Empty(The_Stack); 
end Is_Eii5>ty; 

procedure Top_Of (The_Stack : in Stack; 

Result : out Item) is 

begin 

Result := Top_Of(The_Stack); 
end Top_Of; 

end of modification 

function Is_Egual (Left : in Stack; 

Right : in Stack) return Boolean is 

begin 

if Left.The_Top /- Right.The_Top then 
return False; 

else 

for Index in 1 . . Left.The_Top loop 
if Left.The_Iterns(Index) /= 

Right.The_Iterns(Index) then 

return False; 
end if; 
end loop; 
return True; 
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end if; 
end Is_Eq:ual; 


function Depth_Of (The_Stack : in Stack) return Natural 
is 

begin 

return The_Stack.The_Top; 
end Depth_Of; 

function Is_Empty {The_Stack : in Stack) return Boolean 
is 

begin 

return (The_Stack.The_Top = 0); 
end Is_Empty; 

function Top_Of (The_Stack : in Stack) return Item is 
begin 

return The_Stack.The_Items(The_Stack.The_Top); 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_Of; 

procedure Iterate {Over_The_Stack : in Stack) is 
Continue : Boolean; 
begin 

for The_Iterator in reverse 1 .. 
Over_The_Stack.The_Top loop 

Process(Over_The_Stack.The_Items(The_Iterator), 

Continue); 

exit when not Continue; 
end loop; 
end Iterate; 

end Stack_Seguential_Bounded_Managed_Iterator; 

This procedure is necessary to match the code interface conventions of the current 
implemementation of CAPS. The next step is to generate the PSDL specification for the 
component. The converter program will generate the PSDL automatically with the 
following command: 

ada2psdl filename (without any extension) 

The output file will have the same name as the file name with the psdl extension. 
The generated file for the above example follows: 
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PSDL 


TYPE Stack_Sequential_Bounded_Managed_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Stack : Stack, 

To_The_Stack : Stack 
OUTPUT 

To_The_Stack : Stack 
EXCEPTIONS 

Overflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 

END 

OPERATOR Push 
SPECIFICATION 
INPUT 

The_Item : Item, 

On_The_Stack : Stack 
OUTPUT 

On_The_Stack : Stack 
EXCEPTIONS 

Overflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Underflow 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Stack, 

Right : Stack 
OUTPUT 

Result : Boolean 
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END 


OPERATOR Depth_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Natural 

END 

OPERATOR Is_Empty 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Boolean 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Item 
EXCEPTIONS 

Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : in[t : Item], Continue 
: out[t : Boolean]] 

INPUT 

Over_Tlie_Stack : Stack 

END 

END 

IMPLEMENTATION ADA Stack_Sequential_Bounded_Managed_Iterator 
END 


Each procedure in Ada specifications is associated with an operator in PSDL. The 


input and output streams in PSDL correspond to the procedure input/output parameters. 


The package must then be re-compiled for quality assurance. 


OBJ3 specifications are created next in accordance with the guideline in Chapter 


II. The following is an example of this step (for the previous Ada specifications): 


26 



STACK 0JB3 SPECIFICATION: 


obj STACK[X :: TRIV] is sort Stack . 
protecting NAT . 


*** constructors 


op create 
op copy 
op clear 
op push 
op pop 

*** accessors 

op isequal 
op depthof 
op isempty 
op topof 

*** exceptions 


-> Stack . 
Stack Stack -> Stack . 

Stack -> Stack . 

Elt Stack -> Stack . 

Stack -> Stack . 


Stack Stack -> Bool . 
Stack -> Nat . 
Stack -> Bool . 
Stack -> Elt . 


op underflow : -> Stack . 
op underflow : -> Elt . 


*** variables declaration 


var S SI : Stack . 
var E El : Elt . 


*** axioms 

eq clear(S) = create . 

eq copy(S,SI) = S . 

eq pop(create) = underflow . 
eq pop(push(E,S)) = S . 

eq isequal(S,SI) = S == Si . 

eq depthof(S) = if S == create then 0 

else 1 + depthof(pop(S)) fi 

eq isempty(S) = S == create . 

eq topof(create) = underflow . 
eq topof(push (E, S) ) = E . 

endo 
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The next step is to create the profile code: 

From either the Ada specifications or PSDL: 

procedure Copy (Froin_The_Stack : in Stack; 

To_The_Stack : in out Stack); 

has the signature AB -> B 

° first digit is the number of sort occurrences: 3 
° the number of sort groups is 1 thus N = 1; 

° (1 + N)* digit is the cardinality of the sort group 
° second digit (1 + 1) is : 2 since l[BB]l = 2 
° third digit (2 + 1) is : 1 since [A] is the only unrelated sort group 
° fourth digit (3 + 1) is : 1 since B belongs to the sort group 

thus: profile(Copy) = 3211 

procedure Clear (The_Stack : in 

Clear: A -> A has profile 2201 

procedure Push (The_Item : in 

On_The_Stack : in 

Push: AB -> B has profile 3211 

procedure Pop (The_Stack 

Pop: A -> A has profile 2201 

procedure Is_Equal (Left : in Stack; 

Right : in Stack; 

Result : out Boolean); 

Is_Equal: AB -> C has profile 330 

procedure Depth_Of (The_Stack : in Stack; 

Result : out Natural); 

Depth_Of: A -> B has profile 220 

procedure Is_Empty (The_Stack : in Stack; 

Result : out Boolean); 

Is_Empty: A -> B has profile 220 

procedure Top_Of (The_Stack : in Stack; 

Result : out Item); 


out Stack); 


Item; 

out Stack); 


: in out Stack); 
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Top_Of: A -> B has profile 220 
Summaiy: 



Table 3. Summary of Stack Profile Code 
The profile codes from these components will then be partitioned and represented 
by a Hasse diagram to optimize the multi-filtering retrieval method. 
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rv. CONCLUSIONS AND FUTURE RESEARCH 


This chapter summarizes the concept and the process of populating the software 
base. Lessons learned and suggestions for future research are also mentioned in this 
section. 

A. ACCOMPLISHMENT 

This thesis has described the process of populating the software base and relevant 
method for retrieval, namely, multi-level filtering concept. The components selected 
comprise the base library listed in the Appendix, which can be used for future study and 
testing of the multi-level filtering process. This process is labor intensive and many 
automation issues should be investigated further. Preliminary study of the retrieval has 
been very promising [Ref. 18]. 

B. LESSONS LEARNED 

The process is time intensive. Not all components can be reused. The primary 
difference between engineering reusable components, i.e. nuts and bolts, and software 
engineering is continuity in dimension. A nut will be manufactured only in certain 
dimensions such as 5/8” but a graphical representation of a nut in software engineering 
can be any size. 

The writing of the OBJ3 specifications associated with each component is the 
most difficult task of all. OBJ3 is a functional language, however Ada components are 
written with procedures. Thus multiple out parameters cannot be directly implemented. 
The rationale for using OBJ3 is to attach the semantics of the operations to each data 
type. By attaching this specification to a component the system can refine the retrieving 
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process. The user can accurately retrieve the matched component via this specification. 
However, the user, most of the time, does not search for an exact component, just for an 
approximation of the component. The user must and should inspect and modify the 
component found to meet his/her requirements. Thus completely detailed OBJ3 
specifications may not be that critical. For example: a bounded stack will have an 
overflow exception in its specification. This aspect cannot be easily handled during 
semantic matching. Consequently, the user must supply the size parameter during 
instantiation. This exception can be omitted in the OBJ3 specification because the 
semantic matching process cannot use the information. A more appropriate treatment of 
the exception is to include an informal explanation sufficient to guide the user in 
instantiating the size bound. The informal description part of the PSDL specification can 
be used for this purpose. 

C. FUTURE RESEARCH 

1. Graphical User Interface 

A graphical user interface can make the retrieval process less error prone. The 
user would not need to be an expert in how the software base works. This interface will 
increase productivity. 

2. CAPS and the Internet 

Currently, CAPS can be used on a local area network Unix environment or a stand 
alone Unix workstation. There is a plan to implement CAPS on another microprocessor 
base, namely, the Intel architecture microprocessor. However, CAPS can be used across 
platforms via the Internet. JavaScript, based on the Java language (a derivative of the 
C++ language), and the Internet can make this possible. JavaScript extends the 
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programmatic capabilities of a typical Internet browser, i.e. Netscape, to a wide range of 
authors and is easy enough for anyone who can compose Hyper Text Markup Language 
(HTML). JavaScript can be used to glue HTML, inline plug-ins, and Java applets 
(applications) to each other. It provides the ability to change images, play different 
sounds, and more in response to specified events such as a user mouse click or screen exit 
and entry. 

The JavaScript language resembles Java, but without Java's static typing and 
strong type checking. JavaScript supports most of Java's expression syntax and basic 
control flow constructs, hi contrast to Java's compile-time system of classes built by 
declarations, JavaScript supports a run-time system based on a small number of primitive 
types. The members of numeric, boolean, and string types can be expressed literally. 

Primitive types can be composed into objects by setting properties with the 
assignment operator. JavaScript also supports functions, again without any declarative 
requirements beyond the need to distinguish a function definition from other sentences in 
the language. Functions can be properties of objects, executing as loosely-typed methods. 

JavaScript complements Java by exposing useful properties of Java applets to 
script authors. JavaScript scripts embedded in HTML documents can get and set exposed 
properties in order to query the state or alter the performance of an applet or plug-in. 

Java is an extension language designed, in particular, for fast execution and type 
safety. (Type safety is reflected by being unable to cast a Java int into an object reference 
or to get at private memory by corrupting Java bytecodes). Java's strong typing also 
increases compilation efficiency of Java bytecode to machine code. 
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Java programs consist exclusively of classes and their methods. Java's 
requirements for declaring classes, writing methods, and ensuring type safety make 
programming more complex than JavaScript authoring. Java's inheritance and strong 
typing also tend to require tightly coupled object hierarchies. 

In contrast, JavaScript descends in spirit from a line of smaller, dynamically-typed 
languages like HyperTalk and Dbase. These scripting languages offer programming tools 
to a much wider audience because of their easier syntax, specialized built-in functionality, 
and minimal requirements for object creation. 

In summary, JavaScript can be used to implement World Wide Web access to 
various aspects of CAPS. For example, a graphical user interface, written in JavaScript, 
can enable the user to retrieve a component from the Software Base library. JavaScript 
can provide dialog boxes, error messages, and help systems. These features enable the 
user to interact with CAPS via the Internet without having to fully implement CAPS 
locally. Multimedia (video and audio) can be distributed over the Internet as a marketing 
tool for CAPS. 
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APPENDIX - LIBRARY COMPONENTS 


BOOCH LffiRARY COMPONENTS 

The following lists are grouped by major component class. 


Bags 


1 

Bag_Simple_Sequential_Bounded_Managed_Iterator 

2 

Bag_Simple_Sequential_Bounded_Managed_Noniterator 

3 

Bag_Simple_Sequential_Unbounded_Managed_Iterator 

■ 

Bag_Simple_Sequential_Unbounded_Managed_Noniterator 

5 

Bag_Simple_Sequential_Unbounded_Unmanaged_Iterator 

6 

Bag_Simple_Sequential_Unbounded_Unmanaged_Noniterator 


Lists 


1 

List_Double_Bounded_Managed 

2 

List_Double_Unbounded_Managed 

3 

List_Double_Unbounded_Unmanaged 

H 

List_Single_Bounded_Managed 

5 

List_Single_Unbounded_Managed 

6 

List_Single_Unbounded_Unmanaged 
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Maps 


1 

Map_'^imp1ft_Nnncached Sequential Bounded Managed_Iterator 

2 

Map_Simple_Noncached_Sequential_Bounded_Managed_Noniterator 

3 

Map_Simple_Noncached_Sequential_Unbounded_Managed_Iterator 

4 

Map_Simple_Noncached_Sequential_Unbounded_Unmanaged_Noniterator 

5 

Map_Simple_Noncached_Sequential_Unbounded_Unnianaged_Iterator 
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Queues 


1 

Queue_Nonpriority_Balking_Sequential_Bounded_Managed_Iterator 

2 

Queue_Nonpriority_Balking_Sequential_Unbounded_Managed_Noniterator 

3 

Queue_Nonpriority_Nonbalking_Sequential_Bounded_Managed_Iterator 

H 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Managed_Noniterator 

5 

Queue_Priority_Balking_Sequential_Bounded_Managed_Iterator 

6 

Queue_Priority_Balking_Sequential_Unbounded_Managed_Noniterator 

7 

Queue_Priority_Nonbalking_Sequential_Bounded_Managed_Iterator 

8 

Queue_Priority_NonbaIking_Sequential_Unbounded_Managed_Noniterator 

9 

Queue_Nonpriority_Balking_Sequential_Unbounded_Unmanaged_Iterator 

10 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Uninanaged_Iterator 

11 

Queue_Priority_Balking_Sequential_Unbounded_Unmanaged_Iterator 

12 

Queue_Priority_Nonbalking_Sequential_Unbounded_Unmanaged_Iterator 

13 

Queue_Nonpriority_BaIldng_Sequential_Unbounded_Managed_Iterator 

14 

Queue_Nonpriority_Balking_Sequential_Unbounded_Unmanaged_Noniterator 

15 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Unmanaged_Noniterator 

16 

Queue_Priority_Balking_Sequential_Unbounded_Managed_Iterator 

17 

Queue_Priority_Balking_Sequential_Unbounded_Unnianaged_Noniterator 

18 

Queue_Priority_Nonbalking_Sequential_Unbounded_Unmanaged_Noniterator 
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Rings 


1 

Ring_Sequential_Bouaded_Managed_Iterator 

2 

Ring_SequentiaI_Bounded_Managed_Noniterator 

3 

Ring_5>ftqiientia]JLJnbounded Managed Iterator 

H 

Ring_Sequential_Unbounded_Managed_Noniterator 

5 

Ring_Sequential_Unbounded_Managed_Iterator 

6 

Ring_Sequential_Unbounded_Managed_Noniterator 


Sets 


1 

Set_Simple_Sequential_Bounded_Managed_Iterator 

2 

Set_Simple_Sequential_Bounded_Managed_Noniterator 

3 

Set_Simple_Sequential_Unbounded_Managed_Iterator 

H 

Set_Simple_Sequential_Unbounded_Managed_Noniterator 

5 

Set_Simple_Sequential_Unbounded_Unmanaged_Iterator 

6 

Set_Siinple_Sequential_Unbounded_Unmanaged_Noniterator 
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Sorts & Searchs 


1 

Binary_Search 

2 

Binary_Insertion_Search 

3 

Buble_Sort 

H 

Heap_Sort 

5 

N atural_Merge_Sort 

6 

Ordered_Sequential_Search 

7 

Poly_Sort 

8 

Quick_Sort 

9 

Radix_Sort 

10 

Sequential_Search 

11 

Shaker_Sort 

12 

Shell_Sort 

13 

Straight_Insertion_Sort 

14 

Straight_Selection_Sort 

Stacks 

1 

Stack_Sequential_Bounded_Managed_Iterator 

2 

Stack_Sequential_Unbounded_Managed_Noniterator 

3 

Stack_Sequential_Unbounded_Managed_Iterator 

■ 

Stack_Sequential_Unbounded_Unmanaged_Noniterator 


Stack_Sequential_Unbounded_Unmanaged_Iterator 





















Storage 


1 

Storage_Sequence 

Strings 

1 

String_Sequential_Unbounded_Controlled_Iterator 

2 

String_Sequential_Unbounded_Managed_Iterator 

3 

String_Sequential_Bounded_Unmanaged_Noniterator 

■ 

String_Sequential_Unbounded_Unmanaged_Noniterator 


Trees 


1 

Tree_Arbitrary_Double_Bounded_Unmanaged 

2 

Tree__Arbitrary_Double_Unbounded__Unmanaged 

3 

Tree_Arbitrary_Single_Bounded_Unmanaged 

■ 

Tree_Arbitrary_Single_Unbounded_Unmanaged 
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BAG OBJ3 SPECIFICATIONS 


obj BAG[x :; TRIV] is sort Bag . 
protecting NAT . 

*** constructors 

op create 
op copy 
op clear 
op add 
op remove 
op union 
op intersection 
op difference 

*** accessors 

op isequal : Bag Bag 

op extentof : Bag 

op uniqueextentof : Bag 

op iseitpty : Bag 

op isamember : Elt Bag 

op isasubset : Bag Bag 

op isapropersubset : Bag Bag 

*** exceptions 

op overflow ; -> Bag . 

op itemisnotinbag : -> Bag . 

*** variables declaration 

var B B1 B2 : Bag . 
var E El : Elt . 

*** axioms 

eg copy(B,Bl) = B . 


-> Bool 
-> Nat . 
-> Nat . 
-> Bool 
-> Bool 
-> Bool 
-> Bool 


Bag Bag -> Bag 
Bag -> Bag 
Elt Bag -> Bag 
Elt Bag -> Bag 
Bag Bag Bag -> Bag 
Bag Bag Bag -> Bag 
Bag Bag Bag -> Bag 


eg clear(B) = create . 

eg remove(E,create) = itemisnotinbag . 
eg remove(E,add(El,Bl)) = if E == El then B1 else 
add(El,remove(E,Bl)) fi . 

eg tmion(B,create,Bl) « B . 

eg union(B,add(El,Bl),B2) = add{El,union{B,B1,B2)) . 
eg intersection(B,create,Bl) = create . 

eg intersection(B,add(El,Bl),B2) = if isamember(El,B) then 
add(El,intersection(B,Bl,B2)) else intersection(B,Bl,B2) fi . 

eg difference(B,create,Bl) = B . 
eg difference(create,B,Bl) = B . 

eg difference(B,add(El,Bl),B2) = if isamember(El,B) then 
difference(remove(El,B),B1,B2) else add{El,difference{B,Bl,B2)) fi . 

eg extentof(create) = 0 . 

eg extentof(add(E,B)) = 1 + extentof(B) . 

eg unicpjeextentof (create) = 0 . 

eg uniqueextentof(add(E,B)) = if isamember(E,B) then 
uniqueextentof(B) else 1 + uniqueextentof(B) fi . 

eg isenpty{B) = B create . 

eg isamember(E,create) = false . 

eg isamember(E,add(El,Bl)) » E == El or isamember(E,B1) . 
eg isasubset (create, B) =; true . 

eg isasubset(add(E,B),B1) = if isamember(E,Bl) then isasubset(B,B1) 
else false fi . 

eg isapropersubset(B,B1) = isasubset(B,Bl) and extentof(Bl) > 
extentof(B) . 

endo 


43 





BAGS PROFILE CODES 


OPERATORS 

SIGNATURES 

PROFILE CODES 

COPY 

AB->B 

3211 

CLEAR 

A-> A 

2201 

ADD 

AB->B 

3211 

REMOVE 

AB->B 

3211 

UNION 

ABC->C 

4231 

INTERSECTION 

ABC->C 

4231 

DIFFERENCE 

ABC->C 

4231 

IS_EQUAL 

AB->C 

330 

EXTENT_OF 

A->B 

220 

UNI0UE_EXTENT_OF 

A->B 

220 

IS_EMPTY 

A->B 

220 

IS_A_MEMBER 

AB->C 

330 

IS_A_SUBSET 

AB->C 

330 

IS_A_PROPER_SUBSET 

AB->C 

330 


SET OF PROFILE: {4231,3211,2201,330,220} 
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BAG SIMPLE SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA SPECIFICATIONS 


obj BAG[X :: TRIV] is sort Bag . 
protecting NAT . 

*** constructors 

op create 
op copy 
op clear 
op add 
op remove 
op union 
op intersection 
op difference 

*** accessors 

op isequal : Bag Bag 

op extentof Bag 

op uniqueextentof : Bag 

op isertpty : Bag 

op isamember : Elt Bag 

op isasubset : Bag Bag 

op isapropersubset : Bag Bag 

*** exceptions 

op overflow : -> Bag , 

op itend snotinbag : -> Bag . 

variables declaration 

var B B1 B2 : Bag . 
var E El : Elt . 

axioms 

eq copy{B,Bl) = B . 


-> Bool . 
-> Nat . 
-> Nat , 
-> Bool . 
-> Bool • 
-> Bool . 
-> Bool . 


Bag Bag -> Bag 
Bag -> Bag 
Elt Bag -> Bag 
Elt Bag -> Bag 
Bag Bag Bag -> Bag 
Bag Bag Bag -> Bag 
Baa Baa Baa -> Bag 


eq clear(B) = create . 

eq remove(E,create) = itemisnotinbag . 
eq remove(E,add(El,Bl)) = if E == El then B1 else 
add(El,remove(E,Bl)) fi . 

eq union(B,create,Bl) = B . 

eg union(B,add(El,Bl),B2) = add(El,union(B,Bl,B2)) . 
eq intersection(B,create,Bl) = create . 

eq intersection(B,add(El,Bl),B2) = if isamember(El,B) then 
add(El,intersection{B,Bl,B2)) else intersection{B,Bl,B2) fi . 

eq difference(B,create,Bl) = B . 
eq difference(create,B,Bl) = B . 

eq difference(B,add(El,Bl),B2) = if isamember(El,B) then 
difference{remove(El,B),B1,B2) else add(El,difference(B,Bl,B2)) fi . 

eq extentof(create) = 0 . 

eq extentof(add(E,B)) = 1 + extentof(B) . 

eq xjniqueextentof (create) = 0 . 

eq uniqueextentof (add(E,B)) = if isamember (E,B) then 
uniqueextentof(B) else 1 + uniqueextentof(B) fi . 

eq isempty(B) = B == create . 

eg isamember(E,create) = false . 

eq isamember (E, add (El, Bl)) = E == El or isamember (E,B1) . 

eq isasiibset(create,B) = true . 

eg isasubset (add(E,B) ,B1) = if isamember (E,Bl) then isasubset (B,Bl) 
else false fi . 

eq isapropersubset(B,B1) = isasubset(B,Bl) and extentof(Bl) > 
extentof(B) . 

endo 
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BAG SIMPLE SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA IMPLEMENTATION 


— {C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is sxabject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Con?)uter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

-- Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Bag_Simple_Sequential_Bounded_Managed_Iterator is 

procedure Copy (FronL_The_Bag : in Bag; 

To_The_Bag ; in out Bag) is 

begin 

if FroitL.The_Bag.The_Back > To_The_Bag.The_Size then 
raise Overflow; 

else 

To_The_Bag. The_I terns (1 .. Froni_The_Bag. The^Back} : = 
From_The_Bag. The_Iterns (1 .. FrorrL.The„Bag. The_Back); 
To_The_Bag. The_Back : = From_The_Bag. The_Back ,- 
end if; 
end Copy; 

procedure Clear (The_Bag : in out Bag) is 
begin 

The_Bag.The_Back := 0; 
end Clear; 


procedure Add (The_Item : in I tern,- 

To_The_Bag : in out Bag) is 

begin 

for Index in 1 .. To_The_Bag.The_Back loop 

if The_Item = To^The_Bag.The_Iterns (Index) .The_Item then 
To_The_Bag.The_Items(Index).The_Count := 

To_The_Bag.The_Items(Index).The^Count + 1; 
return; 
end if; 
end loop; 

To_The_Bag.The_Iterns(To_The_Bag.The_Back + 1) .Th€_Item : = 
Item; 

To_The_Bag.The_Iterns(To_The_Bag.The_Back + 1).The_Count := 1; 
To_The_Bag.ThelBack := To_The_Bag.The_Back + 1; 
exception 

when Constraint_Error => 
raise Overflow; 

end Add; 


procedure Remove (The_Item : in Item; 

FroitL_The_Bag : in out Bag) is 

begin 

for Index in 1 .. Frorn_The_Bag. The_Back loop 

if The_Item == FrortL_The_Bag.The_Items(Index) .The_Item then 
if FroiiuThe_Bag.The_Items(Index) .The_Count > 1 then 
From_The_Bag.The_Iterns{Index).The_Count := 
From_The_Bag. The_I terns (Index) . The_Coun t - 1; 

else 

From_The_Bag.The_Iterns(Index .. 

(Froni_The_Bag. The^Back - 

From_The_Bag-The_Iterns((Index +1) 

From_The_Bag.The_Back); 
FrortL.The_Bag.The_Back := From_The_Bag.The^Back - 

end if; 
return; 
end if; 
end loop; 

raise ItertL.Is_Not_In_Bag; 
end Remove; 

procedure Union (Of_The_Bag : in Bag; 

An(l_The_Bag: in Bag; 

To_The_Bag : in out Bag) is 

To_Index : Natural; 

To_Back : Natural; 
begin 

To_The_Bag. The__Items (1 .. Of_The_Bag. The_Back) ; = 

Of_The_Bag. The_Iterns (1 .. Of_The_Bag. The_Back) ; 
To_The_Bag.The_Back := Of_The_Bag.The_Back; 

To_Back := To_The_Bag.The_Back; 
for And_Index in 1 .. And_The_Bag. The_Back loop 
To_Index := To_Back; 
while To_Index > 0 loop 

i f To_The_Bag. The_I terns (To_Index) . The_I tem = 

And_The_Bag.The_Iterns(And^Index) .The_Item then 
exit; 

else 

To_Index := To_Index - 1; 
end if; 
end loop; 

if To_Index = 0 then 

To_The_Bag-The_Iteins (To_The_Bag.The_Back +1) : = 

And_The_Bag. The_I terns (And_Index}; 


To_The_Bag.The_Back := To_The_Bag.The_Back + 1; 

else 

To_The_Bag. The„Iterns (To_Index) . The_Count : = 

To_The_Bag. The_I terns (To_Index) . The^Count + 
And_The_Bag. The_I terns (AncLIndex) . The_Count ; 
end if; 
end loop; 
exception 

when Constraint_Error => 
raise Overflow; 
end Union; 

procedure Intersection (Of_The_Bag : in Bag; 

And_The_Bag : in Bag; 

To_The_Bag ; in out Bag) is 

AncLIndex : Natural; 
begin 

To_The_Bag.The_Back ;= 0; 

for Of_Index in 1 .. Of_The_Bag.The_Back loop 
And_Index := And_The_Bag.The_Back; 
while AndLIndex > 0 loop 

if Of_The_Bag.The_Items(Of_Index) ,The_Item = 

And_The_Bag. The_I terns (Anci_Index) . The_I tem then 
if Of_The_Bag.The_Items(Of_Index) .The_Count < 

And_The_Bag. The_I t ems (And_Index) . The^Count then 
To_The_Bag. The_I t ems (To_The_Bag. The_Back + 

1).The_Item 

:= Of_The_Bag.The_Iterns(Of_Index) .The_Item; 
To_The_Bag. The_I terns (To_The_Bag. The_Back + 

1) .The_Count 

: = 0 f_The_Bag. The_I terns {Of_Index) . The_Count ; 
To_The_iag.The_Back := To_The_Bag.The_Back + 

1; 

else 

To_The_Bag. The_I terns (To_The_Bag. The_Back + 

1).The_Item 

: = Of_The_Bag. The_Iterns (Of_Index) . The_Item; 
To_The_Bag. The_I terns (To_The_B ag. The_Back + 

1) .The_Count 

And_The Bag. The_I terns (And^Index) . The_Count; 

To_The_Bag.The_Back := To_The_Bag.The_Back + 

1; 

end if; 
exit; 

else 

And^Index := And_Index - 1; 
end if; 
end loop; 
end loop; 
exception 

when Constraint_Error => 
raise Overflow; 
end Intersection; 

procedure Difference (Of_The_Bag : in Bag; 

And_The_Bag : in Bag; 

To_The_Bag : in out Bag) is 

And>.Index : Natural; 
begin 

To_The_Bag.The_Back := 0; 

for Of_Index in 1 .. Of_The_Bag.The_Back loop 
And_Index := And_The_Bag.The_Back; 
while And_Index > 0 loop 

i f Of_The_Bag. The_I terns (0 f_Index) . The_I tem = 

An(L_The_Bag. The_I terns (And_Index) , The_I tem then 
exit; 

else 

And_Index := And_Index - 1; 
end if; 
end loop; 

if And^Index = 0 then 

To_The_Bag.The_Items (To_The_Bag.The_Back +1} : = 

Of_The_Bag.The_Items(Of_Index) ; 

To_The_Bag. The_Back := To_The_Bag. The_Back + 1; 
els if Of_The_Bag.The_Items(Of_Index) .The_Count > 

And_The_Bag. The_I terns (And_Index) . The_Count then 
To_The_Bag. The_Items (To_The_Bag. The_Back + 1) . The_I tem 

0 f_The_Bag. The_I terns (0 f _Index) . The_I tem ; 

To_The_Bag. The_I terns (To_The_Bag. The_Back + 

1}.The^Count := 

Of_The_Bag, The_Iterns (Of_Index) . The_Count - 
And_The_Bag. The_I terns (And^Index) . The_Count; 
To_The_Bag.The_Back ;= To_The_Bag.The_Back + 1; 
end if; 
end loop; 
exception 

when Constraint_Error => 
raise Overflow; 
end Difference; 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

— adding procedures to replace functions 

procedure Is^Equal (Left : in Bag; 

Right : in Bag; 


46 



Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Bag : in Bag; 

Result : out Natural) is 

begin 

Result ;= Extent_Of(The_Bag); 
end Extent_Of; 

procedure Unique_Extent_Of (The_Bag : in Bag; 

Result ; out Natural) is 

begin 

Result := Unigue_Extent_Of (The_Bag); 
end tJnigue_Extent_Of ; 

procedure Nuinber_Of {The_Iteni : in Item; 

In_The_Bag : in Bag; 

Result : out Positive) is 

begin 

Result := Number_0£{The_Item,In^The_Bag); 
end Number^Of; 

procedure Is^Ecpty (The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result := Is_Ennpty(The_Bag); 
end Is_Einpty; 

procedure Is^AJIember (The_Item ; in Itern; 

Of_The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result : = Is^AJMember {The_Item, Of jrhe_3ag); 
end Is^jAJlexnber ; 

procedure Is_A—Subset (Left ; in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result := Is_A^Subset(Left,Right); 
end Is_A_S\ibset; 

procedure Is_A_Proper_S\jbset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result ;= Is_^Proper_Subset(Left,Right) ; 
end Is_A_Proper_Subset; 

end of modification 

fimction Is__Equal (Left ; in Bag; 

Right : in Bag) return Boolean is 
Right_Index : Natural; 
begin 

if Left.The^Back /= Right.The^Back then 
return False; 

else 

for Left_Index in 1 .. Left.The_Back loop 
Right_Index := Right .The_Back; 
while Right_Index > 0 loop 

if Left .The_Iterns (Left_Index) .Ihe^Itern = 

Right.The_Items (Right_Index) ,The_Item then 
if Left.The_Iterns(Left_Index).The_Count /= 

Right.The_Items(Right_Index).The^Count then 
return False; 

else 

exit; 
end if; 
else' 

Right_Index ;= Right^Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 
end if; 
end loop; 
return True; 
end if; 
end Is^Equal; 

function Extent_Of (The_Bag : in Bag) return Natural is 
Count : Natural ;= 0; 
begin 

for Index in 1 .. The_Bag.The_Back loop 

Count := Count + The_Bag.The_Iterns(Index).The_Count; 
end loop; 
return Count; 
end Extent_Of; 

function Unique_Extent_Of (The_Bag ; in Bag) return Natural is 
begin 

return The_Bag.The_Back; 
end Unique_Extent_Of; 

function N\imber_Of (The^Item : in Item; 

In_The_Bag : in Bag) return Positive is 


begin 

for Index in 1 .. In_Th€_Bag.The_Back loop 

if The_Item = ln_The_Bag.The_Iterns (Index) .The_Itern then 
re turn In^The JBag. The_I terns (Index) . The_Coun t ; 
end if; 
end loop; 

raise IteitL.Is_^ot_In_Bag; 
end Number_Of; 

flinetion Is_Enpty (The_Bag : in Bag) return Boolean is 
begin 

return (The„Bag.The_Back =0); 
end Is_Eopty; 

function Is_A-.Nember (The^Item : in I tern; 

Of_The_Bag : in Bag) return Boolean is 

begin 

for Index in 1 .. Of_The_Bag.The_Back loop 

if 0f_The_Bag.The_Iterns(Index).The_Itern = The^Item then 
return True; 
end if; 
end loop; 
return False; 
end Is^AJIember; 


function Is^_Subset (Left : in Bag; 

Right : in Bag) return Boolean is 
Right_Index : Natural; 
begin 

for Left_Index in 1 .. Left.The_Back loop 
Right_Index := Right.The_Back; 
while Right^Index > 0 loop 

if Left.The_Iterns(Left_Index).The_Item = 

Right.The_Items(Right_Index).The_Item then 
exit; 

else 

Right_Index ;= Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 

elsif Left.The_Iterns(Left_Index).The^Count > 

Right.The_Iterns(Right_Index).The_Count then 
return False; 
end if; 
end loop; 
return True; 
end Is^A_Subset; 


function Is_A_Proper_Subset (Left : in Bag; 

Right ; in Bag) return Boolean is 
Total_Left_Count : Natural := 0; 

Total_Right_Count : Natural ;= 0; 

Right_Index ; Natural; 

begin 

for Left_Index in 1 .. Left.The_Back loop 
Right_Index := Right.The_Back; 
while Right_Index > 0 loop 

if Left.The^Items(Left_Index) .The_Itera = 

Right.The_lterns(Right_lndex).The_Itern then 
exit; 

else 

Right_Index ;= Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 

elsif Left.The_Items(Left_Index).The_Count > 

Right.The„Iterns(Right_Index).The_Count then 
return False; 
end if; 

Total_Left_Count ;= Total_Left_Coxint + 

Left.The_Iterns(Left_Index).The^Count 

end loop; 

for Index in 1 .. Right.The_Back loop 

Total_Right_Count := Total_Right_Count + 

Right.The_Iterns(Index).The_Count; 

end loop; 

if Left.The_Back < Right.The_Back then 
return True; 

elsif Left.The_Back > Right.The_Back then 
return False; 

else 

return (Total_Left„Count < Total_Right„Co\int) ; 
end if; 

end Is^A^Proper_Subset; 


procedure Iterate (Over_The_Bag : in Bag) is 
Continue : Boolean; 
begin 

for The_Iterator in 1 .- Over_The_Bag.The_Back loop 

Process (Over^The^Bag. The_I terns (The_I t era tor) . The^I tern, 
(Jver_The_Bag.The_Iterns (The_Iterator) .The_Count, 


Continue); 

exit when not Continue; 
end loop; 
end Iterate; 


end Bag_SiiJple_Sequential„Bounded_Managed_Iterator; 
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BAG SIMPLE SEQUENTIAL BOUNDED MANAGED ITERATOR 

PSDL 


TYPE Bag_Siiiiple_Sequential_BoundedJlanaged_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronL.The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Itein_Is_Not„liV_Bag 

END 


OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItertuIs^ot_In_Bag 

END 

OPERATOR Extent^Of 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Iteiruls_Not_In_Bag 

END 


OPERATOR Clear 

SPECIFICATION 

INPUT 

The_Bag : Bag 
OUTPUT 

The_Bag : Bag 
EXCEPTIONS 

Overflow, Itent_IsJNot_In_Bag 

END 

OPERATOR Add 

SPECIFICATION 

INPUT 

The_Item : Item, 

To_The_Bag : Bag 
OUTPUT 

To_The__Bag : Bag 
EXCEPTIONS 

Overflow, Iten\_Is_Not_In_Bag 

END 

OPERATOR Remove 

SPECIFICATION 

INPUT 

The_Item : Item, 

FronL.The_Bag : Bag 
OUTPUT 

FronL.The_Bag ; Bag 
EXCEPTIONS 

Overflow, Itern_IsJJot_In_Bag 

END 


OPERATOR Unigue_Extent_Of 

SPECIFICATION 

INPUT 

The_Bag : Bag 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, ItenL,Is_Not_In_Bag 

END 

OPERATOR IS_EBipty 

SPECIFICATION 

INPUT 

The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Itelr^_Is_Not_In_Bag 

END 

OPERATOR Is^AJIeinber 

SPECIFICATION 

INPUT 

The_Item ; Item, 

Of_The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Itein_Is_Not_In_Bag 

END 


OPERATOR Union 

SPECIFICATION 

INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag ; Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, IteitL.ls_Not_In_Bag 

END 

OPERATOR Intersection 

SPECIFICATION 

INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag ; Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Itein_Is^ot_In_Bag 

END 

OPERATOR Difference 

SPECIFICATION 

INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Iter[uIs_Not_In„Bag 

END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : Bag, 

Right : Bag 


OPERATOR Is_A_Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Iten\_Is_Not_In_Bag 

END 

OPERATOR Is_A_Proper_Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, ItenuIs^ot_In_Bag 

END 

OPERATOR Iterate 
SPECIFICATION 

GENERIC . , ^ 

Process : PROCEDURE[The_Itern : in[t : Item], The_Count : in[t 
Positive], Continue : out[t : Boolean]] 

INPUT 

Over_The_Bag : Bag 
EXCEPTIONS 

Overflow, Iten\_IsJNot_In^Bag 

END 


END 

KEYWORDS: BAG 

DESCRIPTIONS: {Bag, Simple, Sequential, Bounded, Managed, Iterator] 

IMPLEMENTATION ADA Bag_Siitple_Sequential_BoundedwManaged_Iterator 
END 
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BAG SIMPLE SEQUENTIAL BOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Bag_Siinple_SequentialJBoundedLManagedJJoniterator is 

type Bag(The_Size : Positive) is limited private; 


procedure Copy {FroiiuThe_Bag 

To_The_Bag 

procedure Clear (The_Bag 

procedure Add (The_Itein 

To_The_Bag 

procedure Remove {The_Item 

FronuThe_Bag 

procedure Union (Of_'Ihe_Bag 

And_The_Bag 
To_The_Bag 

procedure Intersection (Of_The_Bag 
AncLThe_Bag 
To_The_Bag 

procedure Difference (Of_TheJBag 
And_The_Bag 
To_TheJBag 


in Bag; 
in out Bag); 
in out Bag); 
in Item; 
in out Bag); 
in Item; 
in out Bag); 
in Bag; 
in Bag; 
in out Bag) ; 
in Bag; 
in Bag; 
in out Bag); 
in Bag; 
in Bag; 
in out Bag); 


modified by Tuan Nguyen and Vincent Hong 


— date: 7 April 1995 

— adding procedures to replace functions 


procedure Is_Equal 

procedure Extent_Of 
procedure Unique_Extent_Of 
procedure ls_Errpty 
procedure Is_Aw_Neinber 

procedure Is^A^Subset 


{Left : in Bag; 

Right ; in Bag; 

Result : out Boolean); 

(The_Bag : in Bag; 

Result : out Natural) ; 

(The^Bag : in Bag; 

Result : out Natural); 

(The_Bag : in Bag; 

Result : out Boolean); 

(The_Item : in Item; 

Of_The_Bag : in Bag; 

Result : out Boolean); 

(Left : in Bag; 


Right : in Bag; 

Result ; out Boolean); 

procedure Is_A^Proper_Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean); 

— end of modification 

function Is_Equal (Left 

Right 

function Extent_Of (The_Bag 

function Unique_Extent_Of (The_Bag 
function Number_Of (The_Item 

In^The_Bag 

Positive; 

function Is_Enpty (The_Bag 

func t ion Is_AJlen03er (The_I tem 

Of_The_Bag 

function Is_A-Subset (Left 

Right 

func t ion Is_A_Proper_Subse t (Left 
Right 

Overflow : exception; 

Item_Is_Not_In_Bag : exception; 

private 

type Node is 
record 

The^Item I tern; 

The^Coxmt : Positive; 
end record; 

type Items is array(Positive range <>) of Node; 
type Bag(The_Size : Positive) is 
record 

The_Back : Natural := 0; 

The_Items : Items (1 .. The^Size) ; 
end record; 

end Bag_Simple_Seguential_BoundedJManaged_JIoniterator; 


: in Bag; 

; in Bag) return Boolean; 
: in Bag) return Natural; 
: in Bag) return Natural; 
: in Item; 

: in Bag) return 

: in Bag) return Boolean; 
: in Item; 

; in Bag) return Boolean; 
: in Bag; 

: in Bag) return Boolean; 
; in Bag; 

: in Bag) return Boolean; 
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BAG SIMPLE SEQUENTIAL BOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 GracSy Booch 

— All Rights Reserved 

— Serial Ntumber 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood. 

— Colorado 80227 (1-303-987-1874) 

package body Bag_Sinple_Sequential_Boxmded_Managed_Moniterator is 

procedure Copy (Fron\_The_Bag : in Bag; 

To_The_Bag ; in out Bag) is 

begin 

if Fro:tuThe_Bag.The_Back > To_The„Bag.The_Size then 
raise Overflow; 

else 

To_The_Bag. The_I terns (1 .. FrortuThe_Bag. The^Back) : = 
FronL.The_Bag. The_Iterns (1 .. Froii:u.The_Bag. The_Back) ; 
To_The_Bag. The_Back : = FroituThe.Bag. The_Bac k ; 
end if; 
end Copy; 

procedure Clear (The_Bag : in out Bag) is 
begin 

The_Bag.The_Back := 0; 
end Clear; 


procedure Add (The^Item ; in Item; 

To_The_Bag : in out Bag) is 

begin 

for Index in 1 .. To_The_Bag.The^Back loop 

if The_Item = To_The_Bag-The_Iterns (Index) .The_Item then 
To_The_Bag. The_I terns (Index) . The_Covuit : = 

To_The_Bag. The^Items (Index) . The_Covint + 1 ; 
return; 
end if; 
end loop; 

To_The_Bag.The_Iterns(To_The_Bag.The_Back + 1 ).The_Itern := 
The_Item; 

To_The_Bag.The_Iterns(To_The_Bag.The_Back + 1) .The_Count := 1; 
To_The_Bag.The_Back := To_The_Bag.The_Back + 1; 
exception 

when Constraint_Error => 
raise Overflow; 

end Add; 


D) 


1 ; 


procedure Remove (The_Item : in Item; 

From_The_Bag : in out Bag) is 

begin 

for Index in 1 .. FronuThe_Bag.The_Back loop 

if The_Item = PronuThe_Bag.The_Iterns(Index).The_Itern then 
if FronL_The_Bag.The_Iteins(Index) .The_Count > 1 then 
From_The_Bag.The_Iterns(Index).The_Count := 

From_The_Bag.The_Iterns(Index).The_Count - 1; 

else 

From_The_Bag.The_Iterns(Index .. 

(From_The_Bag.The_Back - 

FroitL.The_Bag-The_Items( (Index + 1) .. 

From_The_Bag.The_Back); 
From_The_Bag.The_Back := FroouThe_Bag.The_Back - 

end if; 
return; 
end if; 
end loop; 

raise 11 eitL.ls_Not_In_Bag ; 
end Remove; 


procedure Union (Of_The_Bag : 

And_The_Bag: 
To_The_Bag : 
Natural; 
Natural; 


in Bag; 

in Bag; 

in out Bag) 

To^Index 
To_Back 
begin 

To_The„Bag.The_Iterns(1 

0 f_The_Bag.The_I terns (1 _ _ 

To_The_Bag.The_Back := Of_The_Bag.The_Back; 

To_Back := To_The_Bag.The_Back; 
for And_Index in 1 .. And_The_Bag.The^Back loop 
To_Index := To_Back; 
while To_Index > 0 loop 

if To_The_Bag.The_Iterns(To_Index).The_Item = 

And_The_Bag.The_Items(And_Index).The_Itern then 
exit; 


Of_The_Bag.The_Back) := 

Of_The_Bag.The_Back); 


else 

To^Index := To_Index - 1; 
end if; 
end loop; 

if To_Index = 0 then 

To_The_Bag.The_Items(To_The_Bag.The_Back +1) := 

And_The_Bag.The_Iterns(And_Index); 


To_The_Bag.The_Back := To_The_Bag.The_Back + 1; 

else 

To_The_Bag.The_Items{To^Index).The_Count ;= 
To_The_Bag.The_Items(To_Index).The_Count + 
And_The_Bag.The_Iterns(And^Index).The^Count; 
end if; 
end loop; 
exception 

when Constraint_Error -> 
raise Overflow; 
end Union; 


procedure Intersection (Of_The_Bag : in Bag; 

And_The_Bag : in Bag; 

To_The_Bag ; in out Bag) is 

AndLIndex ; Natural; 
begin 

To_The_Bag.The_Back := 0; 

for Of_Index in 1 .. Of_The_Bag.The_Back loop 
AndLIndex := An(i_The_Bag.The_Back; 
while And_lndex > 0 loop 

if Of The_Bag.The_Items{Of_Index).The_Item = 

And_The_Bag. The_I terns (AncLIndex) . The_I tern then 
if Of_The__Bag.The_Items{Of_Index) .The^Count < 

And>.The_Bag.The_Iterns (AndLIndex) .The_Count then 
To_The_Bag. The_I terns (To_The_Bag. The_Back + 


1).The_Item 


: = Of_The_Bag.The_Items {Of_Index) .The_Itern; 
To_The_Bag. The_I terns (To_The_Bag. The_Back + 


1).The_Count 


:= Of_The_Bag.The_Items(Of„Index).The^Count; 
To_The_Bag.The_Back := To_The_Bag.The_Back + 


1 ; 

1).The^Item 
1).The_Count 


else 

To_The_Bag.The_Iterns(To_The_Bag.The_Back + 

: = Of_The_Bag. The_Items (Of„Index) .The_Item; 
To_The_Bag. The_I terns {To_The_Bag. The_Back + 


And_The_Bag.The_Iterns (And_Index) .The_Count; 

To_The_Bag.The_Back := To_The_Bag.The_Back + 

1; 

end if; 
exit; 

else 

And_Index :s: AndLIndex - 1; 
end if; 
end loop; 
end loop; 
exception 

when Constraint_Error => 
raise Overflow; 
end Intersection; 

procedure Difference (Of_The_Bag : in Bag; 

AndLThe_Bag : in Bag; 

To_The_Bag : in out Bag) is 

And_Index : Natural; 
begin 

To_The_Bag. The__Back : = 0; 

for Of_Index in 1 .. Of_The_Bag.The_Back loop 
And_Index := And_The_Bag-The_Back; 
while AndLIndex > 0 loop 

if Of_The_Bag.The_Items(Of_Index).The_Item = 

And_The_Bag. The_I terns (And_lndex) . The_I t em then 
exit; 

else 

And_lndex := And_Index - 1; 
end if; 
end loop; 

if AndLIndex = 0 then 

To_The_Bag.The_Items(To_The_Bag.The_Back +1) := 

Of_The_Bag.The_Iterns(Of_Index); 

To_The_Bag.The_Back := To_The_Bag.The_Back + 1; 
elsif Of_The_Bag.The_Items(Of_Index).The_Count > 

And_The_Bag. The_I terns (And_Index) . The_Count then 
To_The_Bag.The_Iterns(To_The_Bag.The_Back + 1).The_Itern 

0 f_The_Bag. The_I terns {0 f_Index) . The_I tern ; 

To_The JBag.The_Iterns(To_The_Bag.The_Back + 

1}.The_Count := 

Of_The_Bag.The_Iteins{Of_Index) .The_Count - 
And_The_Bag .The_I terns (And_Index) . The_Count; 
To_The_Bag.The_Back := To_The_Bag.The_Back + 1; 
end if; 
end loop; 
exception 

when Constraint_Error => 
raise Overflow; 
end Difference; 


— modified by Tuan Nguyen and Vincent Hong 

— date; 8 April 1995 

adding procedures to replace functions 

procedure Is_Equal (Left ; in Bag; 

Right : in Bag; 


50 




Result ; out Boolean) is 

begin 

Result := is^Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Bag : in Bag; 

Result : out Natural) is 

begin 

Result := Extent^Of(The_Bag); 
end Extent_Of; 

procedure Unique_Extent_Of {The_Bag : in Bag; 

Result : out Natural) is 

begin 

Result := Unique_Extent_Of (The_Bag}; 
end Unique_Ext€nt„Of ; 

procedure Nuinber^Of (The_Item : in Item; 

In_The_Bag : in Bag; 

Result : out Positive) is 

begin 

Result : = Nuinber_0f {The_Item, ln_The_Bag) ; 
end Nuinber_Of; 

procedure Is_Enpty {The_Bag : in Bag; 

Result : out Boolean) is 

Isegin 

Result := Is_Empty(The_Bag); 
end Is_Eii:pty; 

procedure Is_AJleiiib€r {The_Item : in Item; 

Of_The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result := Is^JMember{The_Item,Of_The_Bag); 
end Is^A^ember ; 

procedure Is_jA_Siibset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result ls_K,Sxibset(Left,Right) ; 
end Is_A_Subset; 

procedure Is_A^Proper_S\jbset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result : = Is_^Proper_Subset (Lef t, Right) ; 
end Is_A-.Proper_Sxibset; 

end of modification 

f\mction Is_Equal (Left : in Bag; 

Right : in Bag) return Boolean is 
Right_Index : Natural; 
begin 

if Left.The_Back /= Right.The_Back then 
return False; 

else 

for Left_Index in 1 ., Left.The_Back loop 
Right_Index := Right.The_Back; 
while Right^Index > 0 loop 

if Left.The_Items(Left_Index).The_Item = 

Right.The_Iterns(Right^Index).The_Itern then 
if Left.The_Iterns (Lef t_Index) .The_Count /= 

Right. The_I terns (Right_Index) , The_Count then 
return False; 

else 

exit; 
end if; 

else 

Right_Index := Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Egual; 

function Extent_Of (The^Bag : in Bag) return Natural is 
Co\int ; Natural := 0; 
begin 

for Index in 1 .. The_Bag.The_Back loop 

Count := Count + The_Bag.The_Iterns (Index) .The_Count; 
end loop; 
return Coxmt; 
end Extent_Of; 

function Unique_Extent_Of (The_Bag : in Bag) return Natural is 
begin 


return The_Bag.The_Back; 
end Unique_Extent_Of; 

function Number_Of (The_Item : in Item; 

In_The_Bag ; in Bag) return Positive is 

begin 

for Index in 1 .. In_The^Bag.The_Back loop 

if The_Item = In_The_Bag.The_Iterns(Index).The_Itern then 
re turn In_The_Bag. The_I terns (Index) . The_Coun t; 
end if; 
end loop; 

raise Item_Is_Not_In_Bag; 
end Niunber_Of; 

fxinction Is_Enpty (The_Bag : in Bag) return Boolean is 
begin 

return {The_Bag.The_Back =0); 
end Is_Empty; 

function Is.J^ember (The_Item ; in I tern; 

Of_The_Bag : in Bag) return Boolean is 

begin 

for Index in 1 . . Of_The_Bag. The_Back loop 

if Of_The_Bag.The_Items(Index) .The_Itern = The^Item then 
return True; 
end if; 
end loop; 
return False; 
end is^A^ember; 

function Is_A-Subset (Left : in Bag; 

Right : in Bag) return Boolean is 
Right_Index ; Natural; 
begin 

for Left_Index in 1 ., Left.The_Back loop 
Right^Index := Right.The^Back; 
while Right_Index > 0 loop 

if Left .The_Iteins(Left_Index) .The_Item = 

Right,The_Iterns{Right_Index).The_Item then 
exit; 

else 

Right_Index ;= Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 

e Is i f Left. The_I terns (Le f t_Index) . The_Coxint > 

Right.The_Items(Right_Index).The_Count then 
return False; 
end if; 
end loop; 
return True; 
end Is^_Subset; 

fxinction Is^_Proper_Subset (Left : in Bag; 

Right : in Bag) return Boolean is 
Total_Left_Count : Natural := 0; 

Total_Right_Count : Natural := 0; 

Right_Index ; Natural; 

begin 

for Left_Index in 1 .. Left.The^Back loop 
Right_Index ;= Right.The_Back; 
while Right_Index > 0 loop 

if Left .The_Iterns (Left_lndex) .The_Itern = 

Right. The_I terns (Right_Index) . The_I tern then 
exit; 

else 

Right_Index ;= Right_Index - 1; 
end if; 
end loop; 

if Right_Index *= 0 then 
return False; 

elsif Left.The_Items(Left_Index).The^Count > 

Right.The^Items(Right^Index) .The_Count then 
return False; 
end if; 

Total„Left_Count := Total_Left_Count + 

Lef t.The^lterns {Left_Index) .The^Count; 

end loop; 

for Index in 1 .. Right,The_Back loop 

Total_Right_Count ;= Total_Right_Count + 

Right.The_Iterns(Index).The_Count; 

end loop; 

if Left-The_Back < Right.The_Back then 
return True; 

elsif Left.The_Back > Right.The_Back then 
return False; 

else 

return (Total_Lef t_Coiant < Total_Right_Count) ; 
end if; 

end Is^A^Proper_Sribset; 

end Bag_Siiiple_Sequent ial_Bo\indedJManaged_Noniterator; 
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BAG SIMPLE SEQUENTIAL BOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Bag_Sin 5 Jle_Sequeiitial_Bounded_ManagecLJIoniterator 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroiTL_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag ; Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

The_Bag : Bag 
EXCEPTIONS 

Overflow, Iteit\_Is_Not_In_Bag 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The„Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The^Item ; Item, 

FronuThe_Bag : Bag 
OUTPUT 

From_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To__The_Bag : Bag 
OUTPUT 

To_The_Bag ; Bag 
EXCEPTIONS 

Overflow, ItenuisJIot_In_Bag 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 


Overflow, ItenuIs_Not_In^Bag 

END 

OPERATOR Is^Equal 
SPECIFICATION 
INPUT 

Left ; Bag, 

Right : Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, ItenuIs_^ot_In_Bag 

END 

OPERATOR Extent_Of 
SPECIFICATION 
INPUT 

The_Bag ; Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, ItenuIs_Not_Iru.Bag 

END 

OPERATOR Unique_Extent_Of 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, ItenuIs_Not_In_Bag 

END 

OPERATOR Is^Empty 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItenuIs_Not_In_Bag 

END 

OPERATOR Is_AJMember 
SPECIFICATION 
INPUT 

The_Item : Item, 

Of_The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItenuIs_Not_In_Bag 

END 

OPERATOR Is^A^Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Is_A_Proper_Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

END 

IMPLEMENTATION ADA Bag_Siinple_Sequential_Bounded_Managed_Noniterator 
END 
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BAG SIMPLE SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Bag_Siii 5 ile_Sequential_Unl)OundedLManaged_Iterator is 


type Bag is limited private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 
Add 

Remove 

Union 

Intersection 

Difference 


(From_The_Bag 
To_The_Bag 
(The_Bag 
(The_Item 
To_The_Bag 
('rhe_Item 
Froii\_The_Bag 
{Of_The_Bag 
And_The_Bag 
To_The_Bag 
(Of_The_Bag 
And_The_Bag 
To_The_Bag 
(Of_The_Bag 
Andjrhe_Bag 
To_The_Bag 


: in Bag; 

; in out Bag); 
: in out Bag); 
: in Item; 
: in out Bag); 
: in Item; 
: in out Bag) ; 
in Bag; 

: in Bag; 

: in out Bag); 
: in Bag; 

: in Bag ; 

: in out Bag); 
; in Bag; 

: in Bag ; 

: in out Bag); 


— modified by Tuan Nguyen and Vincent Hong 

— date: 7 April 1995 

— adding procedures to replace functions 


procedure Is_Equal 


procedure Extent^Of 
procedure Uni<3ue_Extent_0f 
procedure Is_En 5 >ty 
procedure Is^AJlember 


(Left 

Right 

Result 

(The_Bag 

Result 

(The_Bag 

Result 

{The_Bag 

Result 

{The_Item 

Of_The_Bag 


in Bag; 
in Bag; 
out Boolean); 
in Bag; 
out Natural); 
in Bag; 
out Natural); 
in Bag; 
out Boolean); 
in Itern; 
in Bag; 




Result 

: out Boolean); 


procedure Is_^_Subset 

{Left 

: in Bag; 





Right 

: in Bag; 





Result 

; out Boolean); 


procedure Is_A_Proper_Subset (Left 

; in Bag; 





Right 

: in Bag; 





Result 

; out Boolean); 


end of modification 





fxinction 

Is_Equal 

(Left 

: in Bag; 


Boolean 


Right 

: in Bag) 

return 

fxmction 

Extent_Of 

(TheJBag 

: in Bag) 

return 

Natural 

function 

Unique_Extent_Of 

(The Bag 

: in Bag) 

return Natural 

f\inction 

Number_Of 

(The_Item 

: in Item; 





In_The_Bag 

: in Bag) 

return 


Ltive; 





Boolean 

function 

Is_En?5ty 

(The_Bag 

: in Bag) 

return 

function 

Is_A^Member 

(The_Item 

: in I tern; 




Of_The_Bag 

: in Bag) 

return 

Boolean 

function 

Is^A^Subset 

(Left 

: in Bag; 





Right 

: in Bag) 

return 

Boolean 

function 

Is^A^Proper_StJbset 

(Left 

: in Bag; 




Right 

: in Bag) 

return Boolean 

generic 



in Item; 



with 

procedure Process 

(The^Item : 




The_Count : in Positive; 
Continue : out Boolean); 
procedure Iterate (Over„The_Bag : in Bag); 

Overflow : exception; 

ItertL.ls_Not_In_Bag : exception; 

private 

type Node; 

type Bag is access Node; 

end Bag_Sin:?5le_Seguential_Unbounded^anaged_Iterator; 
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BAG SIMPLE SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 
-- All Rights Reserved 

— Serial Niimber 0100219 

-Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S, Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_JIanager_Sequential; 

package body Bag_Siinple_Sequential_UnboundedLManaged.Iterator is 

type Node is 
record 

The^Item 
The_Count 
Next 

end record; 

procedure Free (TheJJode : in out Node) is 
begin 

The_Node.The_Count := 1; 
end Free; 

procedure Set^Next (TheJJode : in out Node; 

To_Next : in Bag) is 

begin 

The_Node.Next := To_Next; 
end Set_Next; 

function Next^Of (The_Node ; in Node) return Bag is 
begin 

return The_^ode.Next; 
end Next_Of; 

package Node_Manager is new storage_Manager_Sequential 

(Item => Node, 

Pointer => Bag, 

Free => Free, 

Set_Pointer => Set^ext, 
Pointer_Of => Next_Of); 

procedure Copy (Froin_The_Bag : in Bag; 

To__The_Bag : in out Bag) is 

Froin_Index : Bag := FrortuThe_Bag; 

To^Index : Bag; 
begin 

NodeJManager. Free (To_The_Bag) ; 
if FroiiL_The_Bag /= null then 

To_The_Bag ;= Node_Jlanager ,New_ltem; 
To_The_Bag.The_Item := Fron\_Index.The_Itein; 
ToZThe_Bag. The_Coun t : = Fron\_Index. The_Count ; 
To_lndex := To_The_Bag; 

Froiruindex ;= From_Index.Next; 
while Fronuindex /= null loop 

To_Index.Next := Node_Manager.New_Item; 

To_Index := To„Index-Next; 

To^Index.The_Item := FronL.lndex.The_Itein; 
To_Index.The_Coxjnt := Froituindex.The_Count; 
Froituindex := FroituIndex.Next; 
end loop; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 
end Copy; 

procedure Clear <The_Bag : in out Bag) is 
begin 

Node_Manager.Free(The_Bag); 
end Clear; 

procedure Add (The^Item : in Item; 

To_The_Bag : in out Bag) is 
Teaporary^Node : Bag; 

Index : Bag := To_The_Bag; 

begin 

while Index /- null loop 

if Index.The_Itern = The^Item then 

Index.The^Count := Index.The_Count + 1; 
return; 

else 

Index ;= Index.Next; 
end if; 
end loop; 

Tenporary^ode := Node__Manager .New_Item; 

Tenporary_Node .The_Item := The_Item; 

Teirporary_Node - The_Coiint ; = 1; 

TeitporaryJNode .Next := To_The_Bag; 

To_The_Bag := Temporary_Node; 
exception 

when Storage_Error => 
raise Overflow; 


Item; 
Positive; 
Bag; 


end Add; 

procedure Remove (The_Item : in I tern; 

From_The_Bag : in out Bag) is 
Previous : Bag; 

Index : Bag := From_The_Bag; 
begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 
if Index.The_Count > 1 then 

Index.The_Count := Index.The_Co\jnt - 1; 
elsif Previous = null then 

FroituThe_Bag := FrortuThe_Bag.Next; 

Index.Next := null; 

Node_Manager.Free(Index); 

else 

Previous.Next := Index.Next; 

Index.Next := null; 

Node JManager.Free(Index); 
end if; 
return; 

else 

Previous := Index; 

Index ;)= Index.Next; 
end if; 
end loop; 

raise ItenuIs_Not_In_Bag; 
end Remove; 


procedure Union (Of_The_Bag : in Bag; 

And_The_Bag: in Bag; 

To_The_Bag : in out Bag) is 

From_Index : Bag ;= Of_The_Bag; 

To_Index : Bag; 

To_Top : Bag; 

Tenporary_Node : Bag; 

begin 

Node^Manager.Free(To_The_Bag); 
while From_Index /= null loop 

Teitporary_Node ;= Nodejlainager .New_Item; 

TenporaryJJode.The_Item := From_Index.The_Item; 
Teitporary_Node. The_Count : = Froii\_Index. The__Count; 
Tenporary_Node.Next := To_The_Bag; 

To_The_Bag := Tenporary_Node; 

From_.Index := From_Index.Next; 
end loop; 

FroitL-Index := An(i_The_Bag; 

To_Top := To_The_Bag; 
while Fron\_Index i- null loop 
To_Index : = To__Top ; 
while To_Index /= null loop 

if From_Index,The_Item = To_Index.The_Item then 
exit; 

else 

To_Index := To_Index.Next; 
end if; 
end loop; 

if To_Index = null then 

Tenporary_Node := Node_Manager .New_Item; 

Teirporary_Node. The_I tem : = From_Index. The^l tem; 
TeBporary_Node. The_Count : = From_lndex. The^Coimt; 
Teirporary_^ode.Next ;= To_The_Bag; 

To«.The_Bag : = Tenporary^ode ; 

else 

To_Index.The_Count 

To_Index.The_Count From_Index.The_Count; 

end if; 

From_Index := FronuIndex.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Union; 


procedure Intersection {Of_The_Bag : in Bag; 

And_The_Bag : in Bag; 

To_The_Bag : in out Bag) is 

Of_Index ; Bag := Of_The_Bag; 

And_Index : Bag; 

Tenporary_JJode : Bag; 
begin 

Node JManager. Free (To_The_Bag); 
while Of_Index /- null loop 
And_Index : = And^The_Bag; 
while And^Index /= null loop 

if Of_Index.The_Item = And_Index.The_Item then 
TemporaryJMode Node JManager .New_I tern; 

Teicporary_Node, The_I tem :« of_Index. The__I tern; 
if Of_Index.The_Count < And^Index.The_Count then 
TeitporaryJJode. The_Count : = 

Of_Index.The_Count; 

else 

Teitporary_Node. The^Count : = 


And_Index, The_Count ; 

end if; 

Teitporary_Node.Next := To_The_Bag; 
To_The_Bag := Temporary JNode; 
exit; 
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else 

AndLIndex := And_Index.Next; 
end i£; 
end loop; 

Of_Index ;= Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Intersection; 

procedure Difference {Of_The_Bag : in Bag; 

And_The_Bag ; in Bag; 

To_The_Bag ; in out Bag) is 

Of_Index : Bag := Of_The_Bag; 

AndLIndex ; Bag; 

Teit?>orary_JJode ; Bag; 

begin 

Node^anager, Free (To_^e_Bag); 
while Of_Index /= null loop 
AndLIndex := And_The_Bag; 
while AndLIndex /= null loop 

if Of_Index.The_Item = And_Index.The_Iteni then 
exit; 

else 

And_lndex := And_Index.Next; 
end if; 
end loop; 

if AncLindex = null then 

Teitqporary_Node ;= Node^anager .New_Item; 
Teiiporary_JIode.The_Item := Of_Index.The_Item; 
Ten 5 )orary_Node.The_Count ;= Of_Index.The_Count; 
Teit^orary__Node.Next := To_The_Bag; 

To_The_Bag := Temporaryi^Iode ; 
elsif Of_Index.The_Count > And_Index.The_Co\ant then 
Tenporary^ode := NodeJManager .New_ltein; 
Tenporcory_Node. The_Item ; = Of__Index - The_Itern; 
TeirporaryjJode.The_Co\juric := Of_Index.The_Count - 
And__Index - The_Co\jnt ; 
Tei!iporary_j!Jode .Next := To_The_Bag; 

To_The_Bag := Ten 5 )orary_JJode; 
end if; 

Of^Index := Of_Index.Next; 
end loop; 
exception 

when Storage^Error => 
raise Overflow; 
end Difference; 

modified by Tuan Nguyen and Vincent Hong 
date: 8 April 1995 

adding procedures to replace functions 

procedure Is_Equal (Left : in Bag; 

Right ; in Bag; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Bag : in Bag; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Bag); 
end Extent_Of; 

procedure Unique_Extent_Of (The_Bag : in Bag; 

Result : out Natiiral) is 

begin 

Result := Unique_Extent_Of (The_Bag); 
end Unique_Extent_Of; 

procedure Nvunber^Of (The_Item : in Item; 

In_The_Bag : in Bag; 

Result ; out Positive) is 

begin 

Result := Nuinber_Of (The_Item. In_The_Bag); 
end Nmnber_Of; 

procedure Is^Enpty (The^Bag : in Bag; 

Result : out Boolean) is 

begin 

Resul t : - Is_Enipty (The_Bag) ; 
end Is^Enpty; 

procedure Is^_Meinber (The_Item : in Item; 

Of_The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result := ls^AJ4ember(The_Item,Of_The_Bag) ; 
end Is_A_Nember; 

procedure Is^A^Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result := Is^A^Subset(Left,Right); 
end Is_A«Subset; 

procedure Is_A..Proper_Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result := Is_A_Proper_Subset(Left,Right) ; 
end Is^A^Proper_Subset; 

end of modification. 


function Is_Egual (Left : in Bag; 

Right : in Bag) return Boolean is 
Left_Count : Natural 0; 

Right_Co\int : Natural := 0; 

Left_Index : Bag ;= Left; 

Right_.Index : Bag; 

begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /* null loop 

if Left_Index.The_Item := Right^Index.The^Item then 
exit; 

else 

Right_Index ;= Right_Index.Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

elsif Left_Index.The_Count /= Right^Index.The_Count then 
return False; 

else 

Left_Co\int := Left_Count + 1; 

Left_Index ;=: Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right^Index /= null loop 

Right_Count := Right_Count 1; 

Right_Index := Right_Index.Next; 
end loop; 

return (Left_Count = Right^Coxint) ; 
end Is_Egual; 

function Extent_Of (The^Bag : in Bag) return Natural is 
Count ; Natural ;= 0; 

Index : Bag := The_Bag; 

begin 

while Index /= null loop 

Count := Count + Index.The^Count; 

Index := Index.Next; 
end loop; 
return Coxint; 
end Extent_Of; 

function Unique_Extent_Of (The^Bag : in Bag) return Natural is 
Count ; Natural := 0; 

Index ; Bag := The_Bag; 

begin 

while Index /= null loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Unique_Extent_Of; 

function Number^Of (The_Item : in Item; 

In_The_Bag : in Bag) return Positive is 
Index : Bag := In_The_Bag; 
begin 

while Index /= null loop 

if The^Item = Index.The^Item then 
return Index.The_Count; 

else 

Index Index.Next; 

end if; 
end loop; 

raise Item_IsJNot_In_Bag; 
end Nuinber_Of; 

fimction Is^Eirpty (The_Bag : in Bag) return Boolean is 
begin 

return (The_Bag = null); 
end Is^Eopty; 

function Is_A_iMen»t>er (The^Item : in Item; 

Of._The_Bag : in Bag) return Boolean is 
Index ; Bag := Of_The_Bag; 
begin 

while Index /= null loop 

if The^Item = Index.The_Itern then 
return True; 
end if; 

Index Index.Next; 

end loop; 
return False; 
end Is^AJMember; 

function Is_A-.Subset (Left ; in Bag; 

Right : in Bag) return Boolean is 
Left_Index : Bag ;= Left; 

Right_Index : Bag; 
begin 

while Left_Index /= null loop 
Right_Index ;= Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

elsif Left_Index.The_Count > Right_Index.The_Count then 
return False; 

else 

Left_Index := Left^Index.Next; 
end if; 
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end loop; 
return True; 
end Is_^Subset; 

function Is_A_Proper_Subset (Left : in Bag; 

Right : in Bag) return Boolean is 
Unique_Left_Count : Natural ;= 0; 

Unique_Right_Count : Natural := 0; 

Total_Left_Coxint : Natural 0; 

Total_Right_Count ; Natural := 0; 

Left_Index ; Bag := Left; 

Right^Index : Bag; 

begin 

while Left_lndex I- null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left„Index.The_Item = Right^Index.The_Itein then 
exit; 

else 

Right_Index := Hight_Index.Next; 
end if; 
end loop; 

if Right^Index * null then 
return False; 

elsif Left_Index.The_Count > Right^Index.The_Count then 
return False; 

else 

Unique_Left_Count := Unique_Lef t_Cotjnt + 1; 
Total_Left„Count := Total^Left_Coxint + 

Left_Index.The_Count; 

Left_Index := Left_Index.Next; 


end if; 
end loop; 

Right_Index := Right; 

while Right_lndex /= null loop 

Unique_Right_Count := Unique_Right_Count + 1; 
Total_Right_Count := Total_Right_Count + 

Right_Index. The_Count ; 

Right_Index := Right„Index.Next; 
end loop; 

if Unigue_Left_Count < Unique_Right_Count then 
return True; 

elsif Unique_Left_Count > Unigue_Right„Count then 
return False; 

else 

return (Total_Left^Count < Total_Right_Count); 
end if; 

end ls_A_Proper_Subset; 

procedure Iterate (Over_The_Bag ; in Bag) is 
The^Iterator : Bag := Over_The_Bag; 

Continue : Booleein; 

begin 

while The_Iterator /= null loop 

Process(The_Iterator.The_Item, The_Iterator.The_Count, 

Continue); 

exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end Bag„Siit 5 )le_Sequential_UnboundedJlanaged_Iterator; 
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BAG SIMPLE SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

PSDL 


TYPE Bag_Siirple_Sequential_Unboi 2 ndedUManaged_ 
SPECIFICATION 
GENERIC 

Item ; PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FrotrL,The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, ItenL.Is_^ot_In_Bag 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

The_Bag : Bag 
EXCEPTIONS 

Overflow, ItenulS-Not„IrL_Bag 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Bag ; Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, IteitL_Is_Not_In_Bag 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The_Item : Item, 

From_The_Bag : Bag 
OUTPUT 

From_The^Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not^In_Bag 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And^The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Iten\_Is,JJot_In_Bag 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

AncLThe__Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Itertu.Is_Not_In__Bag 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

AncLThe_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Itein_Is_Not_In_Bag 

END 

OPERATOR Is^Equal 
SPECIFICATION 
INPUT 


.Iterator 


Left : Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItenL.Is_Not_In_Bag 

END 

OPERATOR Extent_Of 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, IteiiuXs_Not_In^Bag 

END 

OPERATOR Unique_Extent_Of 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Item_ls_Not_In__Bag 

END 

OPERATOR Is_Etrpty 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Is_AJIember 
SPECIFICATION 
INPUT 

The_Item ; Item, 

Of_The_Bag ; Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_Is_JNot_In_Bag 

END 

OPERATOR Is_A_Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_IsJNot_In_Bag 

END 

OPERATOR Is_A-Proper_Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right ; Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_IsJMot_In_Bag 

END 

OPERATOR Iterate 
SPECIFICATION 
GENERIC 

Process : PROCEDURE [The_Item ; intt : Item], The_Count : in[t 
Positive], Continue : outtt : Boolean]] 

INPUT 

Over_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_lsJNot_In_Bag 

END 


END 

IMPLEMENTATION ADA Bag_Siii5)le_Sequential_UnboundedJ«anage<l_Iterator 
END 
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BAG SIMPLE SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Bag_Siirple_Seguential_Unbounded_^anaged_Noniterator xs 


type Bag is limited private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Add 

Remove 

Union 

Intersection 

Difference 


(From_The_Bag 
To_The_Bag 
{The_Bag 
{The_ltem 
To__The_Bag 
(The_Item 
From_The_Bag 
(Of_The_Bag 
And_The_Bag 
To_The„Bag 
(Of_The_Bag 
And_The_Bag 
To_The_Bag 
(Of_The_Bag 
And^'rhe_Bag 
To_The_Bag 


in 


Bag; 

in 

out 

Bag) 

in 

out 

Bag) 

in 


Item 

in 

out 

Bag) 

in 


Item 

in 

out 

Bag) 

in 


Bag; 

in 


Bag; 

in 

out 

Bag); 

in 


Bag; 

in 


Bag; 

in 

out 

Bag) i 

in 


Bag; 

in 


Bag; 

in 

out 

Bag) ; 


— modified by Tuan Nguyen and Vincent Hong 

— date: 7 April 1995 

— adding procedures to replace functions 



Result 

: out Boolean); 

procedure Is_A-Meint)er 

{The_Item 

: in Item; 

Of_The_Bag 

: in Bag; 


Result 

; out Boolean); 

procedure Is_A_Subset 

(Left 

: in Bag; 

Right 

: in Bag; 


Result 

: out Boolean); 

procedure Is_A_Proper_Subset 

(Left 

; in Bag; 

Right 

: in Bag; 


Result 

; out Boolean); 

end of modification 

function Is_Equal 

(Left : 

in Bag; 

Right : 

in Bag) return Boolean 

function Extent_Of 

(The_Bag : 

in Bag) return Natural 

fxmction Unique_Extent_Of 

{The_Bag : 

in Bag) return Natural 

f\jnction Number^Of 

(The^Item : 

in Item; 


In_The_Bag : 

in Bag) return 

Ltive; 

fvinction Is_Enpty 

(The_Bag ; 

in Bag) return Boolean, 

function Is.AJIeinber 

{The_Item : 

in Item; 

Of_The_Bag : 

in Bag) return Boolean, 

function Is_AwSubset 

(Left : 

in Bag; 

Right : 

in Bag) return Boolean; 

function Is_A^Proper_Subset 

(Left : 

in Bag; 

Right : 

in Bag) return Boolecin; 


procedure Is_Equal 


procedure Extent^Of 
procedure Unique_Extent_Of 
procedure Is^Empty 


(Left 

Right 

Result 

(The_Bag 

Result 

{The_Bag 

Result 

(The_Bag 


in Bag; 
in Bag; 
out Boolean); 
in Bag; 
out Natural); 
in Bag; 
out Natural) ; 
in Bag; 


Overflow : exception; 

Item_Is_Not_In_Bag : exception; 

private 

type Node; 

type Bag is access Node; 

end Bag_Sirrple_Sequential_Unboimded_Managed_Noniterator; 
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BAG SIMPLE SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987. 1988. 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is siibject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood. 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential; 

package body Bag_Sin 5 Jle_Seguential_UnboimdedJlanaged_Noniterator is 

type Node is 
record 

The_Item : Item; 

The_Co\mt : Positive; 

Next : Bag; 

end record; 

procedure Free (The^ode : in out Node) is 
begin 

The_Node-The_Count := 1; 
end Free; 

procedure SetJNext {The_Node : in out Node; 

To_JJext : in Bag) is 

begin 

TheJMode.Next := To_JNext; 
end Set_Next; 

function Next^Of (The_Node : in Node) return Bag is 
begin 

return The^ode.Next; 
end Next_Of; 

package Nodejlanager is new storage_Manager_Sequential 

(Item => Node, 

Pointer => Bag, 

Free => Free, 

Set_Pointer => Set_Next, 
Pointer_Of => Next^Of); 

procedure Copy (From_The_Bag : in Bag; 

To_The_Bag : in out Bag) is 
From_lndex : Bag := From_The_Bag; 

To_Index : Bag; 
begin 

Node_Jlanager, Free (To_The_Bag) ; 
if FronuThe_Bag /= null then 

To_The_Bag := Node_Manager .New_Item; 
To_TheZBag,The_Item := FrortL^Index.The^Item; 

To_The_Bag. The_Count := From_lndex. The_Count; 

To^Index : = To__The_Bag ; 

From_^Index := From_Index.Next; 
while From_Index /= null loop 

To_Index.Next := Node_Jlanager.New_Item; 

To_Index := To_Index.Next; 

To_Index.The_Item := From^Index.The_Item; 
To_Index.The_Count := From_Index,The_Count; 
Froin_Index := From^Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Bag : in out Bag) is 
begin 

Node_Jlanager. Free (The_Bag) ; 
end Clear; 

procedure Add (The_Item : in Item; 

To_The_Bag : in out Bag) is 
TemporaryJNode : Bag ; 

Index : Bag := To_The_Bag; 

begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 

Index.The_Count := Index.The^Count + 1; 
return; 

else 

Index := Index.Next; 
end if; 
end loop; 

Teitporary_Node := NodeJlanager.New^Itern; 

Tenporary_Node. The_Item := The_Item; 

Teirporary_Node. The_Coxjnt : = 1; 

Teirporary_Node.Next := To_The_Bag; 

ToJIhe^Bag Temporary_Node; 

exception 

when Storage_Error => 
raise Overflow; 


end Add; 

procedure Remove (The_Item : in Itern; 

From_The_Bag : in out Bag) is 
Previous : Bag; 

Index : Bag := FroirL.The_Bag; 
begin 

while Index /= null loop 

if Index.The_Itern = The_ltem then 
if Index.The_Count > 1 then 

Index, The_Cotmt := Index. The_Co\mt - 1; 
elsif Previous = null then 

From_The_Bag := FroirL.The_Bag.Next; 

Index.Next null; 

Node..Manager. Free (Index) ; 

else 

Previous.Next := Index.Next; 

Index,Next := null; 

Node_Manager.Free(Index); 
end if; 
return; 

else 

Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

raise Item_Is_Not_In_Bag; 
end Remove; 

procedure Union (Of_The_Bag : in Bag; 

And_The_Bag: in Bag; 

To_The_Bag : in out Bag) is 

Froir\_Index : Bag := Of_The_Bag; 

To_Index : Bag; 

To_Top : Bag; 

Terrporary_Node : Bag; 

begin 

Node_Manager.Free(To_The_Bag); 
while Frort\_Index /= null loop 

Tenporary_Node : = NodeJManager. New„Item; 
Temporary_Node.The_Item := FronL.Index.The_Item; 
Teaporary_Node.The_Count := From_Index.The_Count; 
Temporary_Node.Next := To_The_Bag; 

To_The_Bag := Tenporary_Node; 

FrortL.Index := FrorrL.Index.Next; 
end loop; 

Froit\_Index := And_The_Bag; 

To_Top := To_Th€_Bag; 
while Frortv_Index /= null loop 
To_Index := To_Top; 
while To_Index /- null loop 

if FronL_Index.The_Item = To_Index.The_Itero then 
exit; 

else 

To_Index ;= To_Index.Next; 
end if; 
end loop; 

if To_Index = null then 

Teitporary_Node : = NodeJManS'Ue^ • New_I tem; 
TemporaryJlode.The_Item ;= FroiruIndex.The_Item; 
Teirporary_Node.The_Count Frorr\_Index.The_Count; 
Teirpor ary JNode. Next := To_The_Bag; 

To_The_Bag := Teiiporary_Node ; 

else 

To_Index.The_Count := 

To_Index,The_Count + From_Index.The_Count; 
end if; 

Fron\_Index := From_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Over flow 
end Union; 


procedure Intersection (Of_The_Bag : in Bag; 

AndLThe_Bag : in Bag; 

To_The_Bag ; in out Bag) is 

Of_Index : Bag ;= Of_The_Bag; 

And_lndex : Bag; 

Teirporary_Node : Bag ; 
begin 

Node_Manager.Free(To_The_Bag); 
while Of_Index /- null loop 
And_Index ;= And_The_Bag; 
while AnciLIndex /= null loop 

if Of_Index.The_It€m = And_Index.The_Item then 
Teitporary_Node := Node_Manager .New_Item; 
Teirporary_Nod6• The_Item ;= Of_Index.The_Item; 
if Of_Index.The_Count < And^Index.The_Count then 
TenporaryJIode. The_Count : = 

Of_Index.The_Count; 

else 

Teitporary_Node. The_Count : = 


And_Index. The_,Count; 

end if; 

Terrporary_Node-Next := To_The_Bag; 
To_The_Bag := Tenporary_Node; 
exit; 
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else 

And_Index := And_Index.Next; 
end if; 
end loop; 

Of_Index ;= Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Intersection; 

procedure Difference (Of_The_Bag : in Bag; 

AndLThe^Bag : in Bag; 

To_The„Bag : in out Bag) is 

Of^Index : Bag := Of_The_Bag; 

And_Index : Bag; 

Tenporary^JJode : Bag; 

begin 

NodeJlanager.Free{To_The_Bag); 
while Of_Index /= null loop 
And.Index AndLThe_Bag; 
while And_Index /= null loop 

if Of_Index.The_Item = And_Index.The_Item then 
exit; 

else 

AncLIndex := And_Index.Next; 
end if; 
end loop; 

if And_Index = null then 

Tenporary_Node := Nodejlanager .New_Item; 
Tenporary_;Jode.The_Item ;= Of_Index.The_Item; 
TeirporaryJNode.The_Count := Of_Index.The_Count; 
Teit 5 >orary_Node.Next ;= To_The_Bag; 

To_The_Bag := TemporaryJNfode; 
els if Of_Index.The_Count > And_Index. The_Count then 
Teiiporary_Node := Node_Manager .New_Item; 
Tenporary_Node.The_Item := Of_Index.The_Item; 
Teitqporary_JJode.The_Count Of_Index.The_Count - 
And_Index. The_Count; 
Teitporary_^ode. Next : = To_The_Bag; 

To_The_Bag := Teirporary_JIode; 
end if; 

Of^Index := Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Difference; 

modified by Tuan Nguyen and Vincent Hong 
date: 8 April 1995 

adding procedures to replace fxmctions 

procedure Is_Egual (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result ;= Is_Egual(Left,Right); 
end Is^Equal; 

procedure Extent_Of {The_Bag : in Bag; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Bag); 
end Extent_Of; 

procedure Unique_Extent_Of (The„Bag ; in Bag; 

Result : out Natural) is 

begin 

Result := Unique_Extent_Of (The^Bag); 
end Unique_Extent_Of; 

procedure Nuinber_Of (The_Item : in Item; 

In_The_Bag : in Bag; 

Result : out Positive) is 

begin 

Result := Number^Of(The_Item,In_The_Bag); 
end Nuinber_Of; 

procedure Is^Enpty {The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result := Is_Ertpty (The_Bag); 
end Is^Empty; 

procedure Is_AJMeinber (The_Item : in Item; 

Of_The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result := Is^A^Member(The_Item,Of_The_Bag); 
end Is_A_Nember; 

procedure Is^A^Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result := Is_A_Subset(Left,Right); 
end Is_A_Subset; 

procedure Is_A_Proper_Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result := Is_A^Proper_Subset(Left, Right); 
end Is^A^Proper_Subset; 

end of modification 


function ls_Equal (Left : in Bag; 

Right : in Bag) return Boolean is 
Left_Count : Natural := 0; 

Right_Count : Natural := 0; 

Left_Index : Bag ;= Left; 

Right_Index ; Bag; 

begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index,The_Item then 
exit; 

else 

Right_Index ;= Right_Index.Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

elsif Left_Index.The_Count /= Right_Index.The_Count then 
return False; 

else 

Left_Count := LeftjCount + 1; 

Left_Index := Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right^Index /= null loop 

Right_Co'unt := Right_Count + 1; 

Right_Index ;= Right^Index.Next; 
end loop; 

return (Left^Count = Right_Count); 
end Is_Equal; 

function Extent_Of (The_Bag : in Bag) return Natural is 
Count ; Natural := 0; 

Index : Bag := The^Bag; 

begin 

while Index /= null loop 

Count := Count + Index.The_Count; 

Index := Index.Next; 
end loop; 
return Cotint; 
end Extent_Of; 

function Unigue_Extent_Of (The^Bag : in Bag) return Natural is 
Count : Natural := 0; 

Index : Bag ;= The_Bag; 

begin 

while Index /= null loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Unique_Extent_Of; 

function Number_Of (The_Item : in Item; 

In_The_Bag : in Bag) return Positive is 
Index : Bag := In_The_Bag; 
begin 

while Index /= null loop 

if The_Item = Index.The_Itern then 
return Index.The^Count; 

else 

Index := Index.Next; 
end if; 
end loop; 

raise Item_Is_Not_In_Bag; 
end Number_Of; 

function Is_Enpty (The_Bag : in Bag) return Boolean is 
begin 

return (The_Bag = null); 
end Is_Enipty; 

function Is„,AuJieif>ber (The__Item : in Item; 

Of_The_Bag : in Bag) return Boolean is 
Index : Bag ;= Of_The„Bag; 
begin 

while Index /= null loop 

if The_Item = Index.The_Itern then 
return True; 
end if; 

Index := Index.Next; 
end loop; 
return False; 
end Is,.JL_Member ; 

function Is^A^Subset (Left ; in Bag; 

Right ; in Bag) return Boolean is 
Left_Index : Bag := Left; 

Right_Index : Bag; 
begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_ltem = Right_Index.The_Item then 
exit; 

else 

Right_Index Right_Index.Next; 
end if; 
end loop; 

if Right_lndex = null then 
return False; 

elsif Left_Index.The_Count > Right_lndex.The_Count then 
return False; 

else 

Left_Index := Left_Index.Next; 
end if; 
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end loop; 
return True; 
end Is_A^Subset; 

function Is^A^Proper_S\ibset {Left : in Bag; 

Right ; in Bag) return Boolean is 
Unique_Left_Count : Natural ;= 0; 

Unique_Right_Count ; Natural := 0; 

Total_Left_Count : Natural := 0; 

Total_Right^Cotmt : Natural 0; 

Left_Index ; Bag := Left; 

Right_Index : Bag; 

begin 

while Left_Index j- null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit ; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Right^Index = null then 
return False; 

elsif Left_Index.The„Count > Right_Index.The_Count then 


return False; 

else 

Unique_Lef t_Count ;= Unique_Lef t_Count + 
Total_Left__Count := Total^Left_,Count + 

Left_Index.The_Count; 

Left_Index ;= Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right_Index /= null loop 

Unique_Right_Count := Unique_Right_Co\mt + 1; 
Total_Right_Count := Total_Right_Count + 
Right_Index. The_Co\jnt ; 

Hight_Index := Right_Index.Next; 
end loop; 

if Unique_Left_Count < Unique_Jlight_Count then 
return True; 

elsif Unique_Left_Coiint > Unique_Right_Count then 
return False; 

else 

return {Total_,Left_Count < Total_Right_Count) 
end if; 

end Is^_Proper_Subset; 

end Bag_Sinple_Sequential_Unbounded_Managed^oniterator; 
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BAG SIMPLE SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Bag_Siinple_Sequential_UnboimdedJManaged_Noniterator 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuThe_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not^In_Bag 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Bag ; Bag 
OUTPUT 

The_Bag : Bag 
EXCEPTIONS 

Overflow, ItenL.ls_Not_In_Bag 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The_Item : Item, 

Prom_The_Bag ; Bag 
OUTPUT 

FronuThe_Bag : Bag 
EXCEPTIONS 

Overflow, Iteii\_Is_Not_In_Bag 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

AncLThe__Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag ; Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag ; Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Iteit\_Is_Not_In_Bag 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

An<i_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 


Overflow, ItenL.Is_Not_In_Bag 

END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left ; Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItenuIs^ot_In_Bag 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, lteiru.ls_Not_In_Bag 

END 

OPERATOR Unique_Extent_Of 

SPECIFICATION 

INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, IteitL.ls_Not_In_Bag 

END 


OPERATOR Is_En^ty 

SPECIFICATION 

INPUT 

The_Bag ; Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Over flow, I terruIs_No t_In_Bag 

END 

OPERATOR Is^A_:Member 

SPECIFICATION 

INPUT 

The_Item : Item, 

Of_The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item^Is_Not_In_Bag 

END 

OPERATOR Is_A_Subset 

SPECIFICATION 

INPUT 

Left : Bag, 

Right ; Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Itein_Is_Not_In_Bag 

END 

OPERATOR Is_A_Proper_Subset 

SPECIFICATION 

INPUT 

Left : Bag, 

Right ; Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_Not_.In_Bag 

END 


END 

IMPLEMENTATION ADA Bag_Sin5)le_Sequential_UnboundedJManaged_Noniterator 
END 
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BAG SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Bag_Siiiple_Sequential_Unboimded_Uninanaged^Iterator is 


type Bag is limited private; 


procedure 

Copy 

(FroiiuThe^Bag 

: in 

Bag; 


To_The_Bag 

; in 

out Bag) 

procedure 

Clear 

(The_Bag 

: in 

out Bag) 

procedure 

Add 

(The_Itein 

: in 

Item 


To_The_Bag 

: in 

out Bag) 

procedure 

Remove 

(The_Item 

: in 

Item 


From_The_Bag 

: in 

out Bag) 

procedure 

Union 

(Of_The_Bag 

: in 

Bag; 


And_The_Bag 

: in 

Bag; 



To_The_Bag ; 

in out Bag); 

procedure 

Intersection 

(Of__The_Bag 

: in 

Bag; 


And_The_Bag 

: in 

Bag; 



To_The_Bag 

; in 

out Bag) 

procedure 

Difference 

(Of_The_Bag 

: in 

Bag; 


And_The_Bag 

; in 

Bag; 



To_The_Bag 

: in 

out Bag) 


— modified by Tuan Nguyen and Vincent Hong 

— date: 7 April 1995 

adding procedures to replace functions 


procedure Is_Equal 


procedure 

procedure 

procedure 

procedure 


Extent_Of 

Unique_Extent_Of 

Is^Empty 

Is^AJIeinber 


(Left 

Right 

Result 

(The_Bag 

Result 

(The_Bag 

Result 

(The_Bag 

Result 

(The_Item 

Of_The_Bag 


in Bag; 
in Bag; 
out Boolean); 
in Bag; 
out Natural); 
in Bag; 
out Natural); 
in Bag; 
out Boolean); 
in Item; 
in Bag; 


Result 

procedure Is_A>Subset (Left 

Right 
Result 

procedure Is^A-Proper^Sxibset (Left 
Right 
Result 


out Boolean); 

in Bag; 

in Bag; 

out Boolean); 

in Bag; 

in Bag; 

out Boolean) ; 


end of modification 






function 

Is_Equal 

(Left 

: in 

Bag; 





Right 

: in 

Bag) 

return 

Boolean 

fxinction 

Extent_Of 

(The_Bag 

: in 

Bag) 

return 

Natural 

function 

Unigue_Extent_Of 

(The_Bag 

: in 

Bag) 

return Natural 

function 

Number^Of 

(The_Item 

: in 

Item; 





In_The_Bag 

: in 

Bag) 

return 


itive ; 







function 

Is_Eirpty 

(The_Bag 

: in 

Bag) 

return 

Boolean 

function 

Is_A_Memb€r 

(The_Item 

: in 

Item; 





Of_The_Bag 

: in 

Bag) 

return 

Boolean 

function 

Is^A-.Subset 

(Left 

: in 

Bag; 





Right 

: in 

Bag) 

return 

Boolean 

fxinction 

Is.JL.Pr oper_Subs e t 

(Left 

: in 

Bag; 





Right 

: in 

Bag) 

return 

Boolean 

generic 







with 

procedure Process 

(The^Item : 

in Item; 





The_Count ; 

in Positive; 




Continue ; 

out Boolean); 



procedure Iterate (Over_The_Bag : in Bag); 


Overflow : exception; 

IteiiL.IsJNrot_In_Bag ; exception; 


private 

type Node; 

type Bag is access Node; 

end Bag_Siitple_Sequential_Unbounded_UnmanagecLI terator; 
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BAG SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) {3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software. 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Bag_Siirple_Sequential_UnboundedLUninanaged_Iterator is 

type Node is 
record 

The_Item : Item; 

The_Count : Positive; 

Next : Bag; 

end record; 

procedure Copy (From„The_Bag : in Bag; 

To_The_Bag : in out Bag) is 
From^Index : Bag ;= From_The_Bag; 

To_Index : Bag; 
begin 

if FronuThe_Bag - null then 
TO_The_Bag ;= null; 

else 

To_The Bag := new Node* (The_Item s=> FroiruIndex.The_Item, 
^ The_Count => FroituIndex.The_Count, 

Next => null); 

To_Index := To_The_Bag; 

Frorcuindex := From_Index.Next; 
while From_Index /= null loop 

To_Index. Next := new Node * {The_I tern => 

Fr onuindex. The_I tern, 

The_Count => 

From_Index, The_Count, 

Next => null); 

To^Index := To^Index.Next; 

Froro_Index := From_Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Bag ; in out Bag) is 
begin 

The_Bag := null; 
end Clear; 

procedure Add (The_Item : in Item; 

To_The_Bag : in out Bag) is 
Index : Bag := To_The_Bag; 
begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 

Index.The_Count := Index.The_Count + 1; 
return; 

else 

Index := Index.Next; 
end if; 
end loop; 

To_The_Bag ;= new Node* {The_Item => The^ltem, 

The_Count => 1, 

Next => To_The_Bag); 

exception 

when Storage^Error => 
raise Overflow; 

end Add; 


procedure Union (Of^The_Bag : in Bag; 

And_The_Bag: in Bag; 

To_The_Bag : in out Bag) is 

From_Index ; Bag Of_The_Bag; 

To_Index ; Bag; 

To_Top : Bag; 

begin 

To_The_Bag := null; 

while Fron\_Index /= null loop 

To_The_Bag := new Node* (The_Itern => FronuIndex.The^Item, 
The_Count => FronuIndex.The_Coxint, 

Next -> To_The_Bag); 

FroiA_Index := From_Index. Next ; 
end loop; 

From_Index := An<d_The_Bag; 

ToJTop To_The_Bag; 
while Fronu.Index /= null loop 
To_Index := To_Top; 
while To_Index /= null loop 

if From_Index.The_Item = To_Index-The_Item then 
exit; 


else 

To_Index := To_Index.Next; 
end if; 
end loop; 

if To_Index = null then 

To_The_Bag := new Node*(The_Itern => 
Fronulndex. The_I tern, 

The_Covint -> 


Fr om_Index. The_Co\jnt, 


Next => To_The_Bag); 


else 

To_Index.The_Count := 

To_Index. The_Coiint + Fron\_Index. The_Count ; 
end if; 

From_lndex From_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Union; 


procedure Intersection (Of_The_Bag : in Bag; 

AndLThe_Bag : in Bag; 

To_The_Bag : in out Bag) is 

Of_Index : Bag := Of_The_Bag; 

And_Index : Bag; 
begin 

To_The_Bag := null; 
while Of_Index /= null loop 
AndLIndex : = AncLThe_Bag ; 
while AndLIndex /= null loop 

if Of_Index.The_Item = AncLIndex.The_Item then 

if of_Index-The_Count < AndLIndex.The^Count then 
To_The_Bag := 

new Node* (The_Itern -> Of_Index.The_Item, 
The_Count => Of_Index.The„Count, 
Next => To_The_Bag); 


else 

To_The_Bag := 

new Node' (The_I tern = > And_Index. The_I tem, 
The_Count => AndLIndex.The^Count, 
Next => To_The_Bag); 

end if; 
exit; 

else 

And_lndex ;= And_Index.Next; 
end if; 
end loop; 

Of_Index := Of_Index-Next; 
end loop; 
exception 

when Storage_Error *> 
raise Overflow; 
end Intersection; 


procedure Remove (The^Item : in Item; 

From_The_Bag ; in out Bag) is 
Previous ; Bag; 

Index : Bag := From_The_Bag; 
begin 

while Index /= null loop 

if Index.The_Item = The_Item then 
if Index.The_Count > 1 then 

Index.The_Count := Index.The^Count 
elsif Previous = null then 

From_The_Bag := Fron\_The_Bag.Next; 

else 

Previous.Next := Index.Next; 
end if; 
return; 

else 

Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

raise IteiTUIs_>Iot_In_Bag; 
end Remove; 


procedure Difference {Of_The_Bag : in Bag; 

And_The_Bag : in Bag; 

To_The_Bag : in out Bag) is 

Of_Index : Bag Of_The_Bag; 

AndLIndex : Bag; 
begin 

To_The_Bag:= null; 
while Of^Index /= null loop 
And_Index := And_The_Bag; 
while And_Index /- null loop 

if Of_Index,The_Item = AndLIndex.The_Item 
exit; 


else 

AndLIndex :* AndLIndex.Next; 
end if; 
end loop; 

if AncLIndex = null then 

To_The_Bag new Node* (The„Item => 
Index. The_Item, 


Of_Index. The_Co\mt, 


then 
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Next => To_The_Bag); 

els if Of_Index.The_Count > And^Index. The_Count then 
To_The_Bag ;= new Node' (The_I tern «> 

Of_Index. The_I tern, 

The_Count => 

Of_Index.The_Count - 


AncLIndex, The_Count, 
end if; 

Of_Index := Of.Index.Next; 
end loop; 
exception 

when Storage.Error => 
raise Overflow; 
end Difference; 


Next 


=> To.The.Bag); 


— modified by Tuan Nguyen and Vincent Hong 

— date; 8 April 1995 

— adding procedures to replace functions 

procedure Is.Equal (Left : in Bag; 

Right ; in Bag; 

Result : out Boolean) is 

begin 

Result := Is.Equal(Left,Right); 
end Is.Equal; 

procedure Extent.Of (The.Bag ; in Bag; 

Result : out Natural) is 

begin 

Result := Extent.Of(The.Bag); 
end Extent.Of; 

procedure Unique_Extent_Of {The.Bag ; in Bag; 

Result : out Natural) is 

begin 

Result := Unique.Extent.Of (The.Bag); 
end Unique.Extent.Of; 

procedure Number.Of (The.Item : in Item; 

In.The.Bag ; in Bag; 

Result : out Positive) is 

begin 

Result Nvunber.Of (The.Item, In.The_Bag) ; 
end Nuitiber.Of; 

procedure Is_Einpty (The_Bag ; in Bag; 

Result : out Boolean) is 

begin 

Resul t : = Is.Enpty (The.Bag); 
end Is.Ert^ty; 

procedure Is.A^ember (The.Item : in I tern; 

Of.The.Bag ; in Bag; 

Result : out Boolean) is 

begin 

Result := ls.AJleinber (The.Item,Of_The_Bag) ; 
end Is_A_Meinber; 

procedure Is_A_Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolecin) is 

begin 

Result := Is.AwSubset(Left,Right); 
end Is^A^Subset; 

procedure Is_A.Proper_Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result : = Is.J^Proper_Subset (Lef t, Right); 
end Is.A_Proper_.Svibset; 

— end of modification 


function Is.Equal (Left : in Bag; 

Right : in Bag) return Boolean is 
Left.Count : Natural := 0; 

Right.Count : Natural := 0; 

Left.Index : Bag := Left; 

Right.Index ; Bag; 
begin 

while Left.Index /= null loop 
Right.Index := Right; 
while Right.Index /= null loop 

if Left_Index.The_Item = Right_Index.The.Item then 
exit; 

else 

Right.Index := Hight.Index.Next; 
end if; 
end loop; 

if Right.Index = null then 
return False; 

elsif Left_Index.The_Count /= Right.Index.The.Count then 
return False; 

else 

Left.Count := Left.Count + 1; 

Left.Index := Left.Index.Next; 
end if; 
end loop; 

Right.Index := Right; 

while Right.Index /= null loop 

Right.Count := Right.Count + 1; 

Right.Index : = Right.Index - Next ; 
end loop; 

return (Left.Count = Right_Co\mt); 
end Is_Equal; 


function Extent.Of (The.Bag : in Bag) return Natural is 
Count : Natural := 0; 

Index : Bag ;= The.Bag; 
begin 

while Index /= null loop 

Count ;= Count + Index.The.Count; 

Index := Index.Next; 
end loop; 
return Count; 
end Extent.Of; 

function Unique.Extent.Of (The.Bag : in Bag) return Natural is 
Count ; Natural := 0; 

Index ; Bag ;= The_Bag; 

begin 

while Index /= null loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
return Coxint; 
end Uni<3ue_Extent_0f ; 

function Nxamber.Of (The.Item : in Item; 

In_The_Bag : in Bag) return Positive is 
Index ; Bag ;= In_The_Bag; 
begin 

while Index /= null loop 

if The.Item = Index.The_Itern then 
return Index.The.Count; 

else 

Index := Index.Next; 
end if; 
end loop; 

raise Iten\_Is_Not_In_Bag; 
end Number.Of; 

function Is_Enpty (The_Bag : in Bag) return Boolean is 
begin 

return (TheJBag = null); 
end Is_Empty; 

function Is_A^^einber (The.Item ; in Item; 

Of_The_Bag ; in Bag) return Boolean is 
Index : Bag :=: Of_The_Bag; 
begin 

while Index /= null loop 

if Ihe.ltem = Index.The_Itern then 
return True; 
end if; 

Index := Index.Next; 
end loop; 
return False; 
end Is_AJMember; 

function Is.A^Subset (Left : in Bag; 

Right : in Bag) return Boolean is 
Left.Index ; Bag ;= Left; 

Right.Index : Bag; 
begin 

while Left.Index /= null loop 
Right.Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right.Index.The.Item then 
exit; 

else 

Right.Index := Right.Index.Next; 
end if; 
end loop; 

if Right.Index * null then 
return False; 

elsif Left.Index.The.Count > Right.Index.The.Count then 
return False; 

else 

Left.Index ;= Left.Index.Next; 
end if; 
end loop; 
return True; 
end Is_A>Sxibset; 

fxinction ls_;x^Proper_Subset (Left ; in Bag; 

Right : in Bag) return Boolean is 
Unique.Left.Count ; Natural := 0; 

Unique_Right_Count : Natural := 0; 

Total_Left_Count : Natural := 0; 

Total_Right_Count : Natural := 0; 

Left.Index : Bag := Left; 

Right.Index ; Bag; 

begin 

while Left.Index /= null loop 
Right.Index := Right; 
while Right.Index /= null loop 

if Left.Index.The.Item = Right.Index.The.Item then 
exit; 

else 

Right.Index Right_Index.Next; 
end if; 
end loop; 

if Right.Index = null then 
return False; 

elsif Left_Index.The_Count > Right_lndex.The_Count then 
return False; 

else 

Unigue_Left_Count Unique_Left_Count + 1; 
Total_Left_Count := Total_Left_Count + 

Lef t.Index.The.Count; 

Left.Index := Left.Index.Next; 
end if; 
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end Is_A_Proper_S\ibset; 


end loop; 

Right.Index Right; 

while Right_Index /= null loop 

Unique_Right_Count Unique_Right_Count + 1; 
Total_Right_Count := Total_Right_Count + 
Right_Index.The_Count; 

Right^Index := Right_Index.Next; 
end loop; 

if Unigue_Left_Count < Unique„Right_Co\jnt then 
return True; 

elsif Unique_Left_Count > Unique_Right_Co;nit then 
return False; 

else 

return (Total_Left^Count < Total_Right_Count); 
end if; 


procedure Iterate (Over_The_Bag : in Bag) is 
The_Iterator : Bag := Over_The_Bag; 

Continue : Boolean; 

begin 

while The^Iterator /= null loop 

Process (The_Iterator .The_Iteni, The_Iterator .The_Count 

Continue); 

exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end Bag_Simple„Seguential_UnboxindedLUninanagecL.Iterator; 
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BAG SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

PSDL 


TYPE Bag_Siinple_Sequential_UnboimdecLUnmanaged^Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroirL_The_Bag : Bag, 

To_The_3ag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Iten\_ls_Jlot_In_Bag 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Bag ; Bag 
OUTPUT 

The_Bag : Bag 
EXCEPTIONS 

Overflow, ItenuIs_Not_In_Bag 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Iteia_ls_JJot_In_Bag 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The_Item : Item, 

FronuThe_Bag : Bag 
OUTPUT 

From_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_IsJNot_In_Bag 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_is_Not_In_Bag 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, 11em_IsJNot_In_Bag 

END 

OPERATOR Is^Equal 
SPECIFICATION 
INPUT 


Left : Bag, 

Right : Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_Is_Not^InwBag 

END 

OPERATOR Extent_Of 
SPECIFICATION 
INPUT 

The^Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Unique_Extent_Of 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Is_Empty 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_IsJIot_In_Bag 

END 

OPERATOR lsJ?KJieaibev 
SPECIFICATION 
INPUT 

The^Item : Item, 

Of_The_Bag : Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Is^A_Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right ; Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Is_A-.Proper_Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_Is^ot_In_Bag 

END 

OPERATOR Iterate 
SPECIFICATION 
GENERIC 

Process : PROCEDURE[The_Item : in[t ; Item], The_Count : rn[t ; 
Positive], Continue : out[t : Boolean]] 

INPUT 

Over_The_Bag ; Bag 
EXCEPTIONS 

Overflow, Itenu.ls_Not_In_Bag 

END 

END 

IMPLEMENTATION ADA Bag_Sin5>le_Se(3uential_Uhbounded_UnnianagedLIterator 
END 
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BAG SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Bag_Siitple_Sequential_Unboundec3jJninanagecLNoniterator is 
type Bag is limited private; 

procedure Copy (FroirL_The_Bag : in Bag; 

To_The_Bag ; in out Bag); 

procedure Clear (The_Bag : in out Bag); 

procedure Add (The^ltem : in Item; 

To_The_Bag : in out Bag); 

procedure Remove {The_Item : in Item; 

Froin_The_Bag : in out Bag) ; 

procedure Union {Of„The_Bag : in Bag; 

And_The_Bag : in Bag; 

To_Tlie_Bag : in out Bag) ; 

procedure Intersection (Of_The_Bag : in Bag; 

AncLThe_Bag : in Bag; 

To_The_Bag : in out Bag); 

procedure Difference (Of_TheJBag ; in Bag; 

AncLThe_Bag : in Bag; 

To_The_Bag : in out Bag); 

— modified by Tuan Nguyen and Vincent Hong 

— date: 7 April 1995 

— adding procedures to replace functions 

procedure Is_Egual (Left : in Bag; 

Right : in Bag; 

Result : out Boolean); 

procedure Extent_Of (The_Bag ; in Bag; 

Result ; out Natural); 

procedure Unique_Extent_Of (The_Bag : in Bag; 

Result : out Natural); 

procedure Is_En 5 >ty (The_Bag : in Bag; 


Result : out Boolean) ; 

procedure Is^_Member {The_Item : in Item; 

Of_The_Bag : in Bag; 

Result : out Boolean); 

procedure Is^?L.Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean); 

procedure Is_A^Proper_Subset (Left : in Bag; 

Right : in Bag; 

Result : out Boolean); 

— end of modification 

fxjnction Is^Equal (Left : in Bag; 

Right : in Bag) return Boolean; 

function Extent_Of (The^Bag : in Bag) return Natural; 

ftinction Unique_Extent_Of (The_Bag : in Bag) return Natural; 

function Number^Of (The^Item : in I tern; 

In_The_Bag : in Bag) return 

Positive; 

fiinction Is_En 5 ity (The_Bag : in Bag) return Boolean; 

function Is_J^^ember (The_Item : in I tern; 

Of_The_Bag : in Bag) return Boolean; 

fxmction Is_A-.Subset (Left : in Bag; 

Right ; in Bag) return Boolean; 

function Is_A^Proper_S\ibset (Left : in Bag; 

Right : in Bag) return Boolean; 

(Overflow : exception; 

Itein_Is_Not_In_Bag : exception; 

private 

type Node; 

type Bag is access Node; 

end Bag_SiiTple_Sequential_Unbounded_Unmanaged_Noniterator; 


68 





BAG SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

-Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) {3} (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874} 

package body Bag_Siinple_Sequential_Unbounded_Urmanaged_Noniterator is 

type Node is 
record 

The_Item : Item; 

The_Count : Positive; 

Next : Bag; 

end record; 

procedure Copy (FronuThe_Bag : in Bag; 

To_The_Bag ; in out Bag) is 
Fronulndex : Bag := FronL.The_Bag; 

To_Index : Bag; 
begin 

if FronuThe_Bag = null then 
To_^The_Bag : = null ; 

else 

To_The_Bag ;= new Node'(The_Itern => FroituIndex.The_Item, 
The_Count => FroiiL.lndex.The_Coxint, 
Next => null); 

To_Index := To_The_Bag; 

From_Index := FronuIndex.Next; 
while Prom_Index /= null loop 

To^Index.Next := new Node'(The_Itern -> 

From_Index.The_Item, 

The_Count => 

Fronulndex.The_Count, 

Next => null); 

To_Index := To^Index.Next; 

From_Index := FroiruXndex.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Bag : in out Bag) is 
begin 

The_Bag := null; 
end Clear; 

procedure Add (The_Item : in Item; 

To_TheJBag ; in out Bag) is 
Index : Bag := To_The_Bag; 
begin 

while Index /= null loop 

if Index.The_Item = The_Item then 

Index.The_Cotint Index.The_Count + 1; 
return; 

else 

Index := Index.Next; 
end if; 
end loop; 

To_The_Bag := new Node' {The_I tem => The_Item, 

The_Count => 1, 

Next => To_The_Bag); 

exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Remove (The_Item : in Item; 

From_The_Bag : in out Bag) is 
Previous : Bag; 

Index : Bag := Fron\_The_Bag; 

begin 

while Index /= null loop 

if Index-The_Item = The_Item then 
if Index,The_Count > 1 then 

Index. The_Count := Index. The^Count - 1; 
elsif Previous = null then 

FrortL.The_Bag := From_The_Bag.Next; 

else 

Previous.Next := Index.Next; 
end if; 
return; 

else 

Previous := Index; 

Index Index.Next; 

end if; 
end loop; 

raise Item_Is_Not_In_Bag; 
end Remove; 


procedure Union (Of_The_Bag : in Bag; 

And_The_Bag: in Bag; 

To_The„Bag ; in out Bag) is 

Fronulndex : Bag Of_The_^ag; 

To_Index : Bag; 

To__Top : Bag; 

begin 

To_The_Bag :« null; 

while From_lndex /= null loop 

To_The_Bag := new Node' {The_Item => FronuXndex.The_Item, 

The_Count => Frorn_Index. The_Count, 

Next => To_The_Bag); 

Fronuindex := From_Index,Next; 

end loop; 

Froro^Index := And_The_Bag; 

To_Top := To_The_Bag; 
while Fronuindex /= null loop 
To_Index := To_Top; 
while To_Index /= null loop 

if Fronulndex.The^Item = To_Index.The_Item then 
exit; 


else 


To_Index ;= To_Index.Next; 
end if; 
end loop; 

if To_Index = null then 

To_The_Bag := new Node*(The_Item => 
Fronulndex.The_Item, 


The^Count -> 


From_Index.The^Count, 


Next => To_The_Bag); 


else 

To_Index.The^Count := 

To_Index.The_Count + From_Index.The_Count; 
end if; 

From_Index := FrortuIndex.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Union; 


procedure Intersection (Of_The_Bag : iii Bag; 

AndLThe_Bag : in Bag; 

To_TheJBag : in out Bag) is 

Of_.Index : Bag := Of_The_Bag; 

And_Index : Bag; 
begin 

To_The_Bag ;= null; 
while Of_Index /= null loop 
And_Index := And_The_Bag; 
while AndLIndex /= null loop 

if Of_Index.The_Item * AncLIndex.The^Item then 

if Of_Index.The„Count < And_Index.The_Count then 
To_'Ihe_Bag : = 

new Node'{The_Item => Of_Index,The_Item, 
The^Count => Of_Index,The_Count, 
Next -> To_The_Bag); 

else 


To_The_Bag 

new Node' (The_Item 
The__Count 
Next 


And_Index. The_I tem, 
And_Index.The_Count, 
To_The_Bag); 


end if; 
exit; 


else 

AncLIndex := And_Index.Next; 
end if; 
end loop; 

0 f_Index := 0f_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Intersection; 


procedure Difference (Of_The_Bag : in Bag; 

AncLThe_Bag : in Bag ; 

To_The_Bag : in out Bag) is 
Of_lnd€x : Bag ;= Of_The_Bag; 

AndLIndex : Bag; 
begin 

To_'Ihe_Bag: = null; 
while Of^Index /= null loop 
And_Index := AncLThe_Bag; 
while AndLIndex /= null loop 

if Of_Index.The_Item = And_Index.The_Item then 
exit; 

else 


And_lndex := AncLIndex.Next; 
end if; 
end loop; 

if AndLIndex = null then 

To_The_Bag := new Node'(The_ltem => 
Of_Index. The_Item, 


The_Count => 


Of_Indcx. The_Count, 
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Next => To_The_Bag); 

elsif Of_Index.The_Count > And_Index.The_Count then 
To_The_Bag := new Node' (The_Item => 

Of_Index. The_I tern, 

The_Count => 

Of_Index. The_Count - 


=> To_The_Bag); 


And^Index. The_Count, 

Next 

end if; 

Of_Index Of^Index.Next; 
end loop; 
exception 

when storage_Error => 
raise Overflow; 
end Difference; 

— modified by Tuan Nguyen and Vincent Hong 
date: 8 April 1995 

— adding procedures to replace functions 

procedure Is^Equal {Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result := Is_Equal{Left,Right); 
end Is^Equal; 

procedure Extent_Of {The_Bag : in Bag; 

Result : out Natural) is 

begin 

Result := Extent_Of(The„Bag); 
end Extent^Of; 

procedure Unique^Extent_Of (The_Bag : in Bag; 

Result : out Natural) is 

begin 

Result Unique_Extent_Of (The_Bag); 
end Unigue_Extent_Of; 

procedure Number^Of (The_Item : in Item; 

In_The_Bag : in Bag; 

Result : out Positive) is 

begin 

Result := Number_Of(The_Item,In_The_Bag); 
end Nuinber_Of; 

procedure Is_Eii53ty (The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result Is_Enpty{The_Bag); 
end Is^Empty; 

procedure Is_^AJlember (The_Item ; in Item; 

Of_The_Bag : in Bag; 

Result : out Boolean) is 

begin 

Result ;= Is^_Meinber{The_Item,Of_The_Bag) ; 
end Is^AJKember; 

procedure Is_A_Subset {Left : in Bag; 

Right : in Bag; 

Result : out Boolean) is 

begin 

Result ;= Is_A_Subset(Left,Right); 
end Is_A_Subset; 

procedure Is_A^Proper_Subset (Left ; in Bag; 

Right : in Bag; 

Result ; out Boolean) is 

begin 

Result := Is^_Proper_Subset(Left,Right) ; 
end Is_A_Proper_Subset; 

— end of modification 


function Is__Equal (Left : in Bag; 

Right : in Bag) return Boolean is 
Left^Count : Natural := 0; 

Right_Count : Natural := 0; 

Left_Index : Bag := Left; 

Right_Index : Bag; 

begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit ; 

else 

Right^Index := Right_Index.Next; 
end if; 
end loop; 

if Right_lndex = null then 
return False; 

elsif Left_Index.The_Co^mt /= Right_Index.The_Count then 
return False; 

else 

Left_Count := Left_Count + 1; 

Left^Index := Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right^Index /= null loop 

Right_Count := Right^Count + 1; 

Right_Index := Right_Index.Next; 
end loop; 

return (Left^Count = Right_Count) ; 
end Is_Equal; 


function Extent_Of {The_Bag : in Bag) return Natural is 
Count : Natural := 0; 

Index : Bag := The_Bag; 

begin 

while Index /= null loop 

Count := Co\mt + Index. The_Count; 

Index := Index.Next; 
end loop; 
return Coiant; 
end Extent_Of; 

function Unique_Extent_Of (The^Bag : in Bag) return Natural is 
Count : Natural ;= 0; 

Index : Bag := The_Bag; 
begin 

while Index /= null loop 
Coiant := Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Unique_Extent_Of; 

function Number_0f (The_Item : in Item; 

In_The_Bag : in Bag) return Positive is 
Index : Bag := In_The_Bag; 
begin 

while Index /= null loop 

if The_Item Index.The_Itern then 
return Index.The^Cotint; 

else 

Index := Index.Next; 
end if; 
end loop; 

raise ItenuisJNot_In_Bag; 
end Nuiriber_Of; 

function Is_Empty {The_Bag : in Bag) return Boolean is 
begin 

return (The_Bag = null); 
end Is^Empty; 

fxinction Is_A_Meinber (The_Item : in Item; 

Of_The_Bag : in Bag) return Boolean is 
Index : Bag := Of_The_Bag; 
begin 

while Index /= null loop 

if The_Item = Index.The_Itern then 
return True; 
end if; 

Index := Index.Next; 
end loop; 
return False; 
end Is^A^Member; 

function Is_A_Subset (Left ; in Bag; 

Right : in Bag) return Boolean is 
Left_Index : Bag := Left; 

Right_Index : Bag; 
begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Right^Index = null then 
return False; 

elsif Left_Index.The_Count > Right_Index.The_Count then 
return False; 

else 

Left_Index ;= Le£t_Index.Next; 
end if; 
end loop; 
return True; 
end Is^A-Subset; 

function Is.^Proper_S\ibset (Left : in Bag; 

Right : in Bag) return Boolean is 
Unigue_Left_Count : Natural ;= 0; 

Unique_Right„Count : Natural := 0; 

Total_Left_Count : Natural := 0; 

Total_Right_Coxmt : Natural := 0; 

Left_lndex : Bag := Left; 

Right_Index : Bag; 

begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right^Index := Right_Index.Next; 
end if; 
end loop; 

if Right^Index = null then 
return False; 

elsif Left_Index.The_Cotint > Right_Index.The_Count then 
return False; 

else 

Unique_Left_Count := Unicjue^Lef t_Count + 1; 
Total_Left_Count ;= Total_Left_Count + 

Left_Index.The_Count; 

Left_Index := Left_Index.Next; 
end if; 
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end loop; 

Right_Index ;= Right; 

while Right_Index I- null loop 

Unique_Right_Count Unique_Right_Count + 1; 
Total_Right_Count := Total_Right_Count + 
Right_Index.The_Count; 

Right_Index := Right_Index.Next; 
end loop; 

if Unique_Left_Coxint < Unique_Right_Count then 


return True; 

elsif Unique_Left_Count > Unique_Right_Count then 
return False; 

else 

return {Total_Left_Count < Total_Right_Count) 
end if; 

end Is_A_Proper_Subset; 

end Bag_S iir¥>l e_Sequent ial_UnboundecLUnmanaged_Noni terator 
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BAG SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

PSDL 


TYPE Bag_Siir^le_Seguential_Unbotmded_UninanagecLlNoniterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FrorrL_The_Bag : Bag, 

To_'3flie_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Item_Is_Not_In_Bag 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

The_Bag : Bag 
EXCEPTIONS 

Overflow, ItenL.IsJIot_In_Bag 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Itein : Item, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, ltem_Is_Not_IrL_Bag 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The^Item ; Item, 

From_The_Bag : Bag 
OUTPUT 

From_The_Bag : Bag 
EXCEPTIONS 

Overflow, Itent.Is_Not_In_Bag 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, Itenuls_Not_In_Bag 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag : Bag, 

And_The_Bag : Bag, 

To_The_Bag ; Bag 
OUTPUT 

To^The_Bag : Bag 
EXCEPTIONS 

Overflow, Iten\_Is^ot_InL-Bag 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Bag ; Bag, 

And_The_Bag : Bag, 

To_The_Bag : Bag 
OUTPUT 

To_The_Bag : Bag 
EXCEPTIONS 

Overflow, ItenL.ls_Not_In_Bag 


END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result : Boolecin 
EXCEPTIONS 

Overflow, IteircIs_^ot_In_Bag 

END 

OPERATOR Extent^Of 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, IteitL,Is_^ot_In_Bag 

END 

OPERATOR Unique_Extent„Of 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, ItenuIs_Not_In_Bag 

END 

OPERATOR Is_Einpty 
SPECIFICATION 
INPUT 

The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Iteiit.Is^ot_In_Bag 

END 

OPERATOR Is^A^ember 
SPECIFICATION 
INPUT 

The_Item ; Item, 

Of_The_Bag : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, IteiiuIs^ot_In_Bag 

END 

OPERATOR Is^A^Subset 
SPECIFICATION 
INPUT 

Left : Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item^Is_Not_In„Bag 

END 

OPERATOR Is_A_Proper_Subset 
SPECIFICATION 
INPUT 

Left ; Bag, 

Right : Bag 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Over f low, I tem_IsJtJo t_In_Bag 

END 

END 

IMPLEMENTATION ADA 

Bag_Simple_Sequential_Unbounded_Unmanaged_Noniterator 
END 
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LIST 0BJ3 SPECIFICATIONS 


obj LISTtX :: TRIV] is sort List . 
protecting NAT . 

*** constructors 

op create ; -> List . 

op copy : List List -> List . 

op clear : List -> List . 

op construct ; Elt List -> List . 

op sethead : List Elt -> List . 

*** op swaptail : List List -> List List. 

*** cannot be inplemented 


*** accessors 

op isequal : List List -> Bool . 

op lengthof ; List -> Nat . 

op isnull ; List -> Bool . 

op headof : List -> Elt . 

op tailof : List -"> List . 

*** op predecessorof ; List -> List 

♦** exceptions 

op overflow : -> List . 

op listisnull : -> List . 


op listisnull : -> Elt . 

op notathead : -> List . 

♦** variables declaration 

var L LI : List . 
var E El : Elt . 

**» axioms 

eg copy{L,Ll) = L . 

eg clear(L) - create . 

eg sethead{create,E) = listisnull - 

eg sethead(construct(E,L),E1) = construct{El,create) 
eg isegual{L,Ll) = L == LI . 
eg lengthof{create) = 0 , 

eg lengthof{construct{E,L)) = 1 + lengthof(L) . 

eg isnull(L) = L == create . 

eg headof(create) = listisnull . 

eg headof(construct{E,L)) = E . 

eg tailof(create) = create . 

eg tailof(construct{E,L)) = L . 

eg predecessorof(create) = listisnull . 

*** eg predecessorof(construct{E,L)) = listisnull . 

endo 
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LISTS PROFILE CODES 


OPERATORS 

SIGNATURES 

PROFILE CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

CONSTRUCT 

AB->B 

3211 

SET HEAD 

AB-> A 

3211 

IS_EOUAL 

AB->C 

330 

LENGTH.OF 

A->B 

220 

IS.NULL 

A->B 

220 

HEAD_OF 

A->B 

220 

TAIL.OF 

A->B 

220 

PREDECESSOR_OF 

A->B 

220 


SET OF PROFILE: {3211,2201,330,220} 
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LIST DOUBLE BOUNDED MANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 

The_Size : in Positive; 
package List_po\xble_BoundedJManaged is 

type List is private; 

Null_List : constant List; 

procedure Copy (Fron\„The_List : in List; 

To_The_List ; in out List); 

procedure Clear (The_List : in out List); 

procedure Construct (The^Item ; in Item; 

AncLThe_List : in out List); 

procedure Set_Head (0£_The_List : in out List; 

To_The_Item : in Item); 

procedure Swap_Tail (Of_The_List : in out List; 

And_The_List : in out List); 

— modified Icfy Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace functions 

procedure Is_Egual (Left : in List; 

Right : in List; 

Result : out Booleeui) ; 

procedure Length_Of (Thesist : in List; 

Result : out Natural); 
procedure IsJNull (The^List : in List; 


Result : out Boolean); 
procedure Head_Of (The^List : in List; 

Result : out Item); 

procedure Tail^Of {The^List : in List; 

Result : out List); 

procedure Predecessor_Of {The_List : in List; 

Result : out List); 

— end of modification 

function Is_Equal (Left : in List; 

Right : in List) return Boolean; 
function Length^Of (The_List : in List) return Natural; 

function IsJtJull (The_List : in List) return Boolean; 

function Head_Of (The_List : in List) return Itern; 

function Tail_Of (The_List : in List) return List; 

function Predecessor^Of (The_List ; in List) return List; 

Overflow : exception; 

List^IsJNull : exception; 

Not^t_Head : exception; 

private 

type List is 
record 

The_Head : Natural := 0; 
end record; 

Null_List : constant List := List *(The_Head => 0); 
end List_Double_Bounded_Managed; 


LIST DOUBLE BOUNDED MANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 
All Rights Reserved 

— Serial N\jinber 0100219 

•Restricted Rights Legend" 

Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body List_Double„BoundedLJlanaged is 

type Node is 
record 

Previous : List; 

The_Item ; Item; 

Next : List; 

end record; 

Heap : array(Positive range 1 .. The_Size) of Node; 

Free_List : List; 

procedure Free (The_List : in out List) is 
Ten 5 )orary_Node : List; 
begin 

while The_List /= Null^List loop 
TeirporaryJJode The_List; 

The_Lis t ;= Heap(The_List.The_Head).Next; 

Heap {Teir¥)orary_Node.The_Head) . Previous : = Null^List ; 
Heap(Ten?)orary_Node.The_Head) .Next := Free_List; 
Free_List := TeirporaryJWode ; 
end loop; 
end Free; 

fimction New_Item return List is 
Tensorary_.Node : List; 
begin 

if Free_List - Null_List then 
raise Storage_Error; 

else 

Ten?3orary_Node := Free_List; 

Free_List := Heap(Free_List.The_Head).Next; 

Heap (Ten53orary_Node.The_Head) .Next : = Null_List ; 
return Tetnporary_Node; 
end if; 
end New_,Item; 

procedure Copy (From_The_List : in List; 

To_The_List : in out List) is 
From_Index : List := FrorrL.The_List; 

To_Index : List; 
begin 

Free(To_The_List); 

if Froin_The_List /- Null_List then 
To__The_List : = New_Item; 

Heap(To_The_List.The_Head).The_Item 
Heap (From_Index. The_Head) .The_I tern; 

To_Index := To_The_List; 

Fronuindex := Heap(From_Index.The_Head).Next; 
while Fronulndex /= Null^List loop 

Heap(To_Index.The_Head) .Next := New_Item; 

Heap (Heap (To^Index. The_Head) .Next. The_Head) . Previous 

To_Index; 

To_Index ; = Heap (To_Index. The_Head) .Next ; 

Heap (To_Index. The^Head) . The_I tem ; = 

Heap(From_Index.The_Head),The_Item; 

FroiTuIndex : = Heap (From_Index. The_Head) . Next ; 
end loop; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_List : in out List) is 
begin 

Free(The_List); 
end Clear; 

procedure Construct (The_Item ; in Item; 

And_The_List : in out List) is 
Temporary JNode : List; 
begin 

if And_The_List = Null_List then 
And_The_List := New_Item; 

Heap(And_The_List.The_Head).The_Itern ;= The_Itern; 
elsif Heap(And_The_List.The_Head).Previous = Null_List then 
Temporary_Node := New_Item; 

Heap (Temperary_Node. The_Head) . The_Item : = The_Item; 

Heap (Teitporary_Node .The_Head) .Next := And_The_List; 

Heap(And_The_Lis t.The_Head).Previous := Temperary_Node; 
And-.TheJL.ist ;= TertporaryJJode ; 


else 

raise Not_At_Head; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Construct; 

procediire Set_Head (Of_The_List : in out List; 

To_The_Item : in Item) is 

begin 

Heap(Of_The_List.The_Head) .The_Itern := To_The_Item; 
exception 

when Constraint_Error => 
raise List_Is_,Null; 
end Set_Head; 

procedure Swap_Tail (Of..-TheJLjist : in out List; 

And_The_List : in out List) is 
TemperaryJJode : List; 
begin 

if Andjrhe_List = Null^List then 

if Heap(Of_The_List .The_Head) .Next /= Null_List then 
Tertporary_Node Heap(Of jrhe_List .The_Head) .Next; 

Heap(Temperary_Node.The_Head).Previous := Nu1l_Lis t; 
Heap{Of_The_List.The^Head).Next := Null_List; 
AndLThe_List := Temperary_Node ; 
end if; 

elsif Heap{And_The_List.The_Head).Previous = Null_List then 
if Heap(Of_The_List.The_Head) .Next /= Null_List then 
Temporary_^ode := Heap(Of_„The_List.The_Head) .Next; 
Heap(Temperary_Node.The_Head) .Previous := Null_List; 
Heap(Of_The_List.The_Head).Next := And_The_List; 

Heap (And_The_Lis t. The_Head) . Previous : = Of_The_List; 
And_The„List := Temper ary JNode ; 

else 

Heap(And_The_List.The„Head).Previous := Of_The_List; 
Heap (Of_The_List.The_Head)-Next ;= And^The_List; 
And_The__List Null_List; 
end if; 

else 

raise Not_J^t_Head; 
end if; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Swap_Tail; 

— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

adding procedures to replace functions 

procedure ls_Equal (Left : in List; 

Right : in List; 

Result : out Boolean) is 

begin 

Result := Is_Egual (Left,Right); 
end Is_Equal; 

procedure Length_Of (The_List : in List; 

Result : out Natural) is 

begin 

Result Length_Of (The_List); 

end Length_Of; 

procedure ls_Null (The_List : in List; 

Result : out Boolean) is 

begin 

Result := Is_Null (The_List); 

end Is^Null; 

procedure Head_Of (The^List : in List; 

Result : out Item) is 

begin 

Result ;= Head_Of (The_List); 

end Head_Of; 

procedure Tail_Of {The_List ; in List; 

Result : out List) is 

begin 

Result := Tail^Of (The^List); 

end Tail_Of; 

procedure Predecessor_Of (The__List : in List; 

Result : out List) is 

begin 

Result := Predecessor_Of (The_List); 
end Predecessor_Of; 

— end of modification 

function Is_Egual (Left : in List; 

Right : in List) return Boolean xs 
Left_Index : List := Left; 

Right_Index : List := Right; 
begin 

while Left_lndex /- Null_List loop 

if Heap (Left_Index.The_Head) .The_Item /= 
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Heap{Right_lndex.The_Head).The_Item then 
return False; 
end if; 

Left_Index := Heap {Left_Index.The_Head).Next; 
Right_Index : = Heap (Right^Index. The^Head) . Next; 
end loop; 

return (Right_Index = Null_List); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length^Of (The^List : in List) return Natural is 
Count : Natural := 0; 

Index ; List ;= The_List; 

begin 

while Index /= Null_List loop 
Count Count + 1; 

Index := Heap(Index.The_Head).Next; 
end loop; 
return Count; 
end Length_Of; 

function IsJTull {The_List : in List) return Boolean is 
begin 

return {The_List ~ Null_List); 
end Is^ull; 

function Head_Of (The„List ; in List) return Item is 
begin 


return Heap(The^List.The_Read).The^Item; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end HeacLOf; 

function Tail^Of (TheJList : in List) return List is 
begin 

return Heap(The_List.The^Head).Next; 
exception 

when Constraint_Error => 
raise List_Is_^ull; 
end Tail_Of; 

function Predecessor_Of (The^List : in List) return List is 
begin 

return Heap (The^List.The^ead) . Previous; 
exception 

when Constraint^Error => 

raise List_Is_Null; , 

end Predecessor_Of; 

i?egin 

Free_List.The^Head := 1; 
for Index in 1 .. {The_Si 2 e - 1) loop 
Heap(Index).Previous := Null_List; 

Heap(Index).Next := List'(The_Head => (Index + 1)); 
end loop; 

Heap(The_Size).Next := Null_List; 
end List_Double_BoundedJManaged; 
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UST DOUBLE BOUNDED MANAGED 


PSDL 


TYPE List_DOTable_BoimdecLJlanaged 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroiiuThe_List : List, 

To_The_List : List 
OUTPUT 

To_The_List ; List 
EXCEPTIONS 

Overflow, List_Is_Null, Not^t_Head 

ENU 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_List : List 
OUTPUT 

The_List : List 
EXCEPTIONS 

Overflow, List_Is^ull, Not^t_Head 

END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_Item : Item, 

AndLThe_List ; List 
OUTPUT 

And_The_List : List 
EXCEPTIONS 

Overflow, List^Is_Null, Not_At^Head 

END 

OPERATOR Set^ead 
SPECIFICATION 
INPUT 

Of_The_List ; List, 

To_The_Item : Item 
OUTPUT 

Of_The_List : List 
EXCEPTIONS 

Overflow, List_Is_JJull, Not_At_Head 

END 

OPERATOR Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List : List, 

And_The_List : List 
OUTPUT 

Of_The_List : List, 

And_Tlie_List : List 
EXCEPTIONS 

Overflow, List_Is^Null, Not^At_Head 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : List, 

Right : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At^ead 

END 

OPERATOR Length^Of 

SPECIFICATION 

INPUT 

The^List : List 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR IS^Null 

SPECIFICATION 

INPUT 

The_List ; List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR HeadLOf 

SPECIFICATION 

INPUT 

TheJCiist : List 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, List_Is_JJull, Not_Jvt_Head 

END 

OPERATOR Tail^Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Predecessor_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result ; List 
EXCEPTIONS 

Overflow, List_ls^ull, Not^t_Head 

END 

END 

IMPLEMENTATION ADA List_Double_Bounded_Managed 
END 
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UST DOUBLE UNBOUNDED MANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 
package List_Doiable_UnboundedL^anaged is 


type List 

is private 





Null_List 

: constant 

List; 




procedure 

Copy 

(From_The_Lis t 

: in 


List; 


To_The_List 

; in 

out 

List) 

procedure 

Clear 

(The_List 

: in 

out 

List) 

procedure 

Construct 

(The_Item 

: in 


Item; 


And_The__List 

; in 

out 

List) 

procedure 

Set_Head 

(Of_The_List 

: in 

out 

List; 


To_The_Item 

: in 


Item) 

procedure 

Swap_Tail 

{Of_The_List 

: in 

out 

List; 


And_The_List 

: in 

out 

List) 


Result 

procedure HeacLOf {The^List 

Result 

procedure Tail_Of {The^List 

Result 

procedure Predecessor^Of (The_List 
Result 


end of modification 


function Is_Equal 

function Length^Of 
function Is^Null 
fxmction Head_Of 
function Tail_Of 
function Predecessor_Of 


(Left 

Right 

(The^List 

(The_List 

(The_List 

(The^List 

(The_List 


: out Boolean); 
: in List; 

: out Item); 

: in List; 

: out List); 

; in List; 

: out List); 


in List; 

in List) return Boolean; 
in List) return Natural; 
in List) return Boolean; 
in List) return Item; 
in List) return List; 
in List) return List; 


— modified Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace fxinctions 


Overflow : exception; 
List«Is_Null : exception; 
Not_At_Head : exception; 


procedure Is_Equal 

procedure Length^Of 
procedure IsJNull 


(Left 

Right 

Result 

(The_List 

Result 

(The_List 


in List; 
in List; 
out Boolean); 
in List; 
out Natural); 
in List; 


private 

type Node; 

type List is access Node; 

Null_List : constaint List := null; 
end List_Dotible_Unbounded_Jlanaged; 
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LIST DOUBLE UNBOUNDED MANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

-Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 
--of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential; 

package body List_Double_UnboundedUManaged is 

type Node is 
record 

Previous : List; 

The_Item : Itern; 

Next : List; 
end record; 

procedure Free (TheJJode ; in out Node) is 
begin 

The_Node.Previous := null; 
end Free; 

procedure Set__Next {The_JJode ; in out Node; 

To_Next : in List) is 

begin 

The_Node. Next : = To_Next ; 
end Set_Ne3ct; 

function Next_Of {The_Node : in Node) return List is 
begin 

return The^Node.Next; 
end Next_Of; 

package Node_Manager is new Storage^anager_Sequential 

(Item => Node, 

Pointer => List, 

Free => Free, 

Set_Pointer => Set_Next, 

Pointer_Of => Next_Of); 

procedure Copy {From_The_List : in List; 

To_The_List ; in out List) is 
From_lndex : List := Prom_„The_List ; 

To_Index : List; 
begin 

Node.J4anager. Free (To_The_Li s t) ; 
if FroitL.The_List /- null then 

To_The_List := Node_Nanager .New_Item; 
To_The_List.The_Item := FroiTuIndex.The_Item; 
To_Index := To_The_List; 

From_Index := FronuIndex.Next; 
while From_Index /= null loop 

To_Index. Next Node_Manager ,New_Item; 

To_Index. Next. Previ ous : = To_Index; 
To_Index := To_Index.Next; 
To_Index.The_Item := FronuIndex.The_Item; 
Fronuindex := From_Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear {The_List : in out List) is 
begin 

Node_Manager.Free(The_List); 
end Clear; 

procedure Construct (The_Item : in I tern,- 

And_The_List : in out List) is 
Tenporary^ode ; List; 
begin 

if And_The_List = null then 

And_The_List := Node_Jlanager.New_Item; 
AncLThe_List.The_Item := The_Item; 
elsif And_The_List.Previous = null then 

Teinporary_Node := Node_Manager .New_Item; 

Tenporary_Node. The_l tern ;= The_Item; 
Tenporary_Node.Next ;= AncLThe_List; 
And_The_List. Previous := Teirporary^ode ; 
And^The^List := Temperary_Node ; 

else 

raise Not_^t_Head; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Construct; 

procedure SetJHead {Of_The_List : in out List; 


To_The_Item : in Item) is 

begin 

Of_The_List.The^Item := To_The_Item; 
exception 

when Constraint_Error => 
raise List_Is^ull; 
end Set_Head; 

procedure Swap__Tail {Of„The_List : in out List; 

And_The_List : in out List) is 
Tertporary_JJode : List; 
begin 

if And_The_List = null then 

if Of_The_List.Next /= null then 

TeitporaryJNode := Of_The_List.Next; 
Teitporary^Node.Previous := null; 
Of_The_List.Next null; 

AndLThe_List := TemperaryJNode; 
end if; 

elsif And_The_List.Previous = null then 
if Of_The_List.Next /= null then 

Tenporary_Node := Of_The__List.Next; 
Of_The_List.Next.Previous := null; 
Of_The_List.Next := And_The_List; 
AncLThe_List.Previous := Of_The_List; 
And_The_List := Teinporary_Node ; 

else 

And_The_List.Previous := Of_The_List; 

Of_The_Lis t.Next := And_The_List; 
AndLThe_List := null; 
end if; 

else 

raise Not_At_Head; 
end if; 
exception 

when Constraint^Error => 
raise List^IsJJull; 
end Swap^Tail; 


modified by Vincent Hong and Tuan Nguyen 
date: 9 April 1995 

adding procedures to replace functions 


procedure Is_Equal 


begin 

Result := Is_Equal 
end Is^Equal; 

procedure Length_Of 

begin 

Result := Length_Of 
end LengthjOf; 

procedure IsJJull 

begin 

Result := Is_Null 
end Is_Null; 

procedure Head_Of 

begin 

Result i- Head_Of 
end Head_Of; 

procedure Tail_Of 

begin 

Result := Tail_Of 
end Tail_Of; 


(Left : in List; 

Right : in List; 

Result : out Boolean) is 

(Left,Right); 


(The_List : in List; 

Result : out Natural) is 

(The_List); 


(The_List : in List; 

Result : out Boolean) is 

(The_List) ; 


(The^List : in List; 
Result : out Item) is 

(The_List); 


(The_List : in List; 
Result ; out List) is 

(The_List) ; 


procedure Predecessor_Of (The_List : in List; 

Result : out List) is 

begin 

Result := Predecessor_Of {The_List); 
end Predecessor^Of; 


end of modification 


function Is_Equal (Left : in List; 

Right ; in List) return Boolean is 
Left_Index : List := Left; 

Right_Index : List ;= Right; 
begin 

while Left^Index /= null loop 

if Left_Index.The_Item /= Right_Index.The_Item then 
return False; 
end if; 

Left^Index :» Left^Index.Next; 

Right_Index Hight_lndex.Next; 
end loop; 

return {Right_lndex = null); 
exception 

when Constraint_Error => 
return False; 
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end Is_Egual; 

function Length_Of (The_List : in List) return Natural is 
Count : Natural ;= 0; 

Index : List := The_List; 

begin 

while Index /= null loop 
Coxint := Count + 1; 

Index := Index.Next; 
end loop; 
retxim Count; 
end Length^Of; 

function Is^ull (The_List : in List) return Boolean is 
begin 

return (The_List = null); 
end IsJMull; 

function Head>.Of (The^List : in List) return Item is 
begin 

return The_List.The_Item; 
exception 


when Constraint_Error => 
raise List_Is^ull; 
end Head^Of; 

function Tail_0f (The_List : in List) return List is 
begin 

return The_List.Next; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Tail^Of; 

function Predecessor_Of {The_List : in List) return List is 
begin 

return The_List.Previous; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Predecessor_Of; 

end List_Double_UnboxindedLManaged; 
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UST DOUBLE UNBOUNDED MANAGED 


PSDL 


TYPE List_Double_Unboimde<^Managed 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Frorn_The_List : List, 

To_The_List : List 
OUTPUT 

To_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_AtJHead 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_List : List 
OUTPUT 

•Rie^List : List 
EXCEPTIONS 

Overflow, List_IsJNul 1, Not_At_Head 

END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_Item : Item, 

And_The_List : List 
OUTPUT 

AndLThe_List : List 
EXCEPTIONS 

Overflow, List_IsJNull, Not^t_Head 

END 

OPERATOR Set_Head 
SPECIFICATION 
INPUT 

Of_The_List : List, 

To_The_Item : Item 
OUTPUT 

Of_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not^t_Head 

END 

OPERATOR Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List : List, 

And_The_List : List 
OUTPUT 

Of_The_List ; List, 

And_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At^e 2 id 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : List, 

Right : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The^List : List 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Is_Null 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_IsJNull, Not^t^Head 

END 

OPERATOR Head^Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, List_Is_Null, Not^t_Head 

END 

OPERATOR Tail_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Predecessor_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

END 

IMPLEMENTATION ADA List_Double_Unbounded_Managed 
END 
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LIST DOUBLE UNBOUNDED UNMANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 

package List_Double_Unbounded^Uniiianaged is 
type List is private; 

Null_List : constant List; 


Result : out Boolean) 
procedure Head_Of {The_List : in List; 

Result : out Item); 

procedure Tail_0£ {The_List : in List; 

Result : out List); 

procedure Predecessor_Of (The^List : in List; 

Result : out List); 


procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Construct 

Set_Head 

Swap_Tail 


{FroitL_The_Lis t 
To_The_List 
(The_List 
(The_Item 
And_The_List 
(Of_The_List 
To_The_Item 
(Of„The_List 
And_The_List 


in List; 
in out List); 
in out List); 
in Item; 
in out List); 
in out List; 
in Item) ; 
in out List; 
in out List); 


end of modification 

function Is_Equal 

f\inction Length_Of 
function Is^^Jull 
function HeacSLOf 
function Tail_Of 
function Predecessor. 


(Left : in 

Right : in 
(The_List : in 
(The_List : in 
(The_List : in 
(The_List : in 
_Of (The^List : in 


List; 

List) return Boolean; 
List) return Natural; 
List) return Boolean; 
List) return Itern; 
List) return List; 
List) return List; 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 i^ril 1995 

adding procedures to replace functions 


Overflow : exception; 
List_Is_Null ; exception; 
Not^tJHead : exception; 


procedure Is_Equal 

procedure Length_Of 
procedure ls_Null 


(Left 

Right 

Result 

(The_List 

Result 

(The_List 


in List; 
in List; 
out Boolean); 
in List; 
out Natural) ; 
in List; 


private 

type Node; 

type List is access Node; 

Null_List : constant List := null; 
end List_Double_Unbounded_Uninanaged; 
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LIST DOUBLE UNBOUNDED UNMANAGED 


ADA IMPLEMENTATION 


(C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial N\iinber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in siibdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

-- Software Clause of FAR 52.227-7013. Manufacturer: 

-- Wisard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body List_Double_Unbounded_Unmanaged is 


type Node is 
record 

Previous : List; 
The_Item ; Item; 
Next : List; 
end record; 


procedure Copy {FrottuThe_List ; in List; 

To_The_List : in out List) is 

Fronuindex : List := FronuThe_List; 

To^Index : List; 
begin 

if Front_The_List = null then 
To_The_List null; 

else 

To_The_List := new Node*(Previous => null, 

~ ” The_Item => From_Index.The_Item, 

Next => null); 

To_Index ;= To_The_List; 

Froitulndex := Froin_Index.Next; 
while Froii\_Index (- null loop 

To^Index.Next := new Node' (Previous => To_Index, 
The_Itein => 

From_Index. The_Item, 

Next => null); 


To^Index := To_Index-Next; 
From_Index : = Froin_Index. Next ; 
end loop; 
end if; 
exception 

when Storage_Error 
raise Overflow; 
end Copy; 


procedure Clear (The_List ; in out List) is 
begin 

The_List := null; 
end Clear; 


procedure Construct (The_Item : in Item; 

And^The_List ; in out List) is 

begin 

if And_The_List = null then 

AncLThe_List := new Node‘ (Previous => null, 

The_Item => The_ltem, 

Next => null); 

elsif And_The_List-Previous = null then 

AncUThe_List := new Node* (Previous => null, 

The^Item => The_Item, 

Next => And_The_List) ; 

And_The_List. Next .Previous := And_The_j:ist ; 

else 

raise NoC_At_Head; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Construct; 

procedure Set^Head (Of_The_List : in out List; 

To_The_Item : in Item) is 

begin 

Of_The_List.The_Item := To_The_Item; 
exception 

when Constraint_Error => 
raise List_Is_^ull; 
end SetJHead; 

procedure Swap_Tail {Of_The_List : in out List; 

And_The_List : in out List) is 
TeirporaryJIode : List; 
begin 

if And_The_List = null then 

if Of_The_List.Next /= null then 

Temporary_Node := Of_The_List.Next; 
Teir? 5 orary^ode.Previous := null; 

Of_The_List.Next := null; 

AndJThe^List := Teit^jorary^Node ; 
end if; 

elsif And_The_liist.Previous = null then 
if Of_ahe_List.Next /= null then 

TemporaryJMode ;= Of_The_List .Next; 


Teitporary_Node.Previous := null; 
Of_The_List.Next := And_The_List; 
AncLThe_List.Previous ;= Of_The_List; 
And_The_List := Temporary_Node; 

else 

And_The_List.Previous := Of_The^List; 
Of_The_List.Next := And_The_List; 
And_The_List := null; 
end if; 

else 

raise Not^t_Head; 
end if; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Swap_Tail; 


modified by Vincent Hong cuid Tuan Nguyen 
date; 9 April 1995 

adding procedures to replace functions 

procedure Is^Egual (Left ; in List; 

Right : in List; 

Result : out Boolean) is 

begin 

Result :s Is^Equal (Left,Right); 
end Is_Equal; 


procedure Length_0f (The_List : in List; 

Result : out Natural) is 

begin 

Result := Length_0f (The_List); 

end Length^Of; 


procedure Is_Null (The_List : in List; 

Result : out Boolean) is 

begin 

Result ;= IsJMull (The^List); 

end Is_Null; 


procedure Head_Of (The^List ; in List; 

Result : out Item) is 

begin 

Result := Head^Of (The_List); 

end Head_0f; 


procedure Tail_Of (The_List : in List; 

Result : out List) is 

begin 

Result ;= Tail_0f (The_List); 

end Tail_Of; 


procedure Predecessor_Of (The_List ; in List; 

Result : out List) is 

begin 

Result := Predecessor_Of (The_List); 
end Predecessor_Of; 


end of modification 


function Is_Equal (Left : in List; 

Right : in List) return Boolean is 
Left^Index ; List ;= Left; 

Right_Index ; List := Right; 
begin 

while Left„Index /= null loop 

if Left_Index.The_Item /= Right_Index.The_Item then 
return False; 
end if; 

Left_Index := Left_Index.Next; 

Right_Index := Right_Index.Next; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length_Of (The_List : in List) return Natural is 
Coxant : Natural := 0; 

Index : List := The_List; 

begin 

while Index /= null loop 
Count ;= Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Length_Of; 

function Is_Null (The^List : in List) return Boolean is 
begin 

return (The^List = null); 
end Is^Null; 

function Head_Of (The_List : in List) return Item is 
begin 

return The_List-The_Item; 
exception 
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when Constraint^Error => 
raise List_Is_^Iull; 
end HeadLOf; 

function Tail_Of (The_List : in List) return List is 
begin 

return The^List.Next; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Tail_Of; 


function Predecessor_Of (The_List : in List) return List is 
begin 

return The_List.Previous; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Predecessor^Of; 

end List_Double_Unbo\inded_Uninanaged; 
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LIST DOUBLE UNBOUNDED UNMANAGED 


PSDL 


TYPE List_Do\A>le_Unbo\xnded_Unnianaged. 

SPECIFICATION 

GENERIC 

Item : PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_List : List, 

To_The_List : List 
OUTPUT 

To_The_List : List 
'EXCEPTIONS 

Overflow, List_Is_Null, Not_At^Head 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The^List : List 
OUTPUT 

The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_Itein : Item, 

And_The_List : List 
OUTPUT 

And_The_List ; List 
EXCEPTIONS 

Overflow, List^Is_Null, NotJ^t^Head 

END 

OPERATOR Set_Head 
SPECIFICATION 
INPUT 

Of_The_List ; List, 

To_The_Item : Item 
OUTPUT 

Of_The„List ; List 
EXCEPTIONS 

Overflow, List_Is_Null, Not^t^Head 

END 

OPERATOR Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List : List, 

And_The_List : List 
OUTPUT 

Of_The_List ; List, 

And_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : List, 

Right : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null, Not^t^Head 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Is_Null 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Head^Of 

SPECIFICATION 

INPUT 

TheJUist : List 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, List_Is_Null, Not^t_Head 

END 

OPERATOR Tail_Of 

SPECIFICATION 

INPUT 

The_List ; List 
OUTPUT 

Result : List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

OPERATOR Predecessor_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result ; List 
EXCEPTIONS 

Overflow, List_Is_Null, Not_At_Head 

END 

END 

IMPLEMENTATION ADA List_Douhle_Unbounded_Uninanaged 
END 
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LIST SINGLE BOUNDED MANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 

The_Size : in Positive; 
package List_Single_BoundedJManaged is 

type List is private; 

Null_List ; constant List; 

procedure Copy (From_The_List : in List; 

To_The_List ; in out List); 

procedure Clear {Tlie_List : in out List) ; 

procedure Construct (The^Item : in Item; 

Andjrhe_List : in out List); 

procedure Set_Head (Of_The_List : in out List; 

To_The_Item ; in Item) ; 

procedure Swap_Tail (Of_The_List : in out List; 

And_The_List : in out List); 

— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace functions 

procedure Is_Equal (Left : in List; 

Right : in List; 

Result : out Boolean); 

(The_List : in List; 


Result : out Natural); 
procedure Is_Null (The^List : in List; 

Result : out Boolean); 
procedure Head_Of {The_List ; in List; 

Result : out Item); 

procedure Tail_Of (The_List : in List; 

Result : out List); 

— end of modification 

function Is_Equal (Left : in List; 

Right : in List) return Boolean; 
fxanction Length_Of (The_List : in List) return Natural; 

function IsJNull (The__List : in List) return Boolean; 

ftinction Head_Of (The_List : in List) return Item; 

f\jnction Tail^Of {The_List : in List) return List; 

Overflow : exception; 

List_Is^ull : exception; 

private 

type List is 
record 

The__Head ; Natural := 0; 
end record; 

Null_List : constant List ;= List'{The_Head => 0); 
end List_Single_Bounded^Managed; 


procedure Length_Of 



LIST SINGLE BOUNDED MANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 GracSy Booch 

— All Rights Reserved 

— Serial Nuniber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) tii) 

— of the rights in Technical Data and Coj^nputer 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body List_Single^ounded^anaged is 

type Node is 
record 

The_Item : Item; 

Next : List; 

end record; 

Heap : array(Positive range 1 .. The_Size) of Node; 
Free_List : List; 

procedure Free (The_List : in out List) is 
Terrporary_Node : List; 
begin 

while The^List f- Null_List loop 
Tenporary_Node := The_List; 

The_List ;= Heap(The_.List.The_Head) .Next; 

Heap(TeitporaryJNode.The__Head) .Next := Free_List; 
Free_List := Tenporary_Node; 
end loop; 
end Free; 

fxmction New_Item return List is 
TemporaryJtJode : List; 
begin 

if Free_List = Null_List then 
raise Storage^Error; 

else 

Temperary^Node := Free_List; 

Free-List := H€ap(Free_List.The_Head).Next; 

Heap (TernporaryJJode. The_Head) .Next := Null_List; 
return Teitporary_Node ; 
end if; 
end New_Item; 

procedure Copy (Froin_The_List : in List; 

To_The_List : in out List) is 
From_Index : List := FronL.The_List; 

To^Index : List; 
begin 

Free(To_The_List); 

if From_The_List /= Null^List then 
To__The_Lis t : = New_I tern ; 

Heap(To„The_List.The_Head).The_Itern := 

Heap (From_Index. The_Head) . The_I tern ; 

To_Index := To_The_List; 

Fronulndex : = Heap (From_Index. The_Head) . Next; 
while From_Index /= Null^List loop 

Heap(To_Index.The_Head) .Next := New_Item; 
To_Index : = Heap {To_Index. The_Head) . Next; 
Heap (To_Index. The^ead) . The_Itern ; = 

Heap (From_Index. The_Head) . The_I tern; 
From^Index = Heap {From_Indcx. The^ead) . Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear {The_List : in out List) is 
begin 

Free{The_List); 
end Clear; 

procedure Construct (The_Item : in Item; 

And_The_List : in out List) is 
Tenporary^Node : List; 
begin 

Tenporary_Node := New_Item; 

Heap{Teinporary__Node .The__Head) .The_Item The_Item; 

Heap {Temporary_Node, The_Head) . Next ; = And^The_List; 
An<^The_List := Temperary^Node; 
exception 

when Storage_Error => 
raise Overflow; 
end Construct; 

procedure Set_Head (Of_The_List : in out List; 

To_The_Item : in Item) is 

Heap (Of_The_List. The_Head) . The_Itern : = To_The_Item; 
exception 


when Constraint_Error => 
raise List_Is_Null; 
end Set_Head; 

procedure Swap_Tail (Of_The_List : in out List; 

And_The_List : in out List) is 
Temporary JtJode : List; 
begin 

Tenporary_Node : Heap (Of_The_L i s t. The_Head) . Next ; 
Heap (Of_The_List. The_Head) . Next : = And_The_List ; 
AndLThelList := Temperary_JJode ; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Swap_Tail; 

modified by Vincent Hong and Tuan Nguyen 
date: 9 April 1995 

adding procedures to replace functions 

procedure Is^Equal (Left ; in List; 

Right : in List; 

Result : out Boolean) is 

begin 

Result := Is_Equal (Left,Right); 
end Is_Egual; 

procedure Length_Of (The^List : in List; 

Result : out Natural) is 

begin 

Result ;= Length_Of (The_List); 

end Length^Of; 

procedure IsJJull (The_List : in List; 

Result : out Boolean) is 

begin 

Result := Is^Null {The_List); 

end Is_JJull; 

procedure HeacLOf 

begin 

Result ;= HeadJOf 
end Head_Of; 

procedure Tail_Of (The^List : in List; 

Result ; out List) is 

begin 

Result := Tail_Of (The^List); 

end Tail_0f; 

end of modification 

function Is^Equal (Left : in List; 

Right : in List) return Boolean is 
Left_Index : List := Left; 

Right_Index : List := Right; 
begin 

while Left_Index /= Null_List loop 

if Heap(Left_Index.The_Head).The_Item /= 
Heap(Right_Index.The_Head).The_Item then 
return False; 
end if; 

Left_Index := Heap{Left_Index.The_Head).Next; 
Right^Index := Heap(Right_Index.The_Head}.Next; 
end loop; 

return (Right^Index = Null_List); 
exception 

when Cons traint__Error => 
return False; 
end Is_Equal; 

function Length^Of (The_List : in List) return Natural is 
Count ; Natural := 0; 

Index ; List ;= The_List; 

begin 

while Index /= Null_List loop 
Coiint ;= Count + 1; 

Index := Heap(Index.The^Head).Next; 
end loop; 
return Count; 
end Length_Of; 

function Is^ull (The^List : in List) return Boolean is 
begin 

return (The_List = Null_List); 
end Is^Null; 

function Head..Of (The_List : in List) return Item is 
begin 

return Heap(The_List.The_Head).The_Item; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end HeacLOf; 

fxmction Tail_0f (The_List : in List) return List is 
begin 


(The_List : in List; 
Result : out Item) is 

(The_List}; 
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return Heap(The_List,The_Head).Next; 
exception 

when Constraint_Error *> 
raise List_Is_Null; 
end Tail^Of; 

begin 


Free_List.The^Head ;= 1; 

for Index in 1 .. (The_Size - 1} loop 

Heap(Index).Next := List*(The^Head «> (Index + 1)) 
end loop; 

Heap(The^Size).Next :» Null_List; 
end List_Single_Bounded_Managed; 
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LIST SINGLE BOUNDED MANAGED 


PSDL 


TYPE List_Single_BovindedLManaged 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_List : List, 

To_The_List : List 
OUTPUT 

To_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_List : List 
OUTPUT 

The_List : List 
EXCEPTIONS 

Overflow, List_Is„Null 

END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_Item : Item, 

AncLThe_List : List 
OUTPUT 

And_The__List : List 
EXCEPTIONS 

Overflow, List_IsJJull 

END 

OPERATOR Set^Head 
SPECIFICATION 
INPUT 

Of_The_List : List, 

To_The_I tern : I tern 
OUTPUT 

Of_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List : List, 

AncLThe_List : List 
OUTPUT 

Of_The_List : List, 

Aiid_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 


END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : List, 

Right ; List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR IS_Null 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Head_Of 

SPECIFICATION 

INPUT 

The__LiSt : List 
OUTPUT 

Result ; Item 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Tail_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

END 

IMPLEMENTATION ADA List_Single_Boxmded_Managed 
END 
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UST SINGLE UNBOUNDED MANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 
package List_Single_UriboundedJlanaged is 

type List is private; 

Null_List : constant List; 


procedure Is_JIull 
procedure Head_Of 
procedure Tail_Of 


Result 

(The_List 

Result 

(The_List 

Result 

(The_List 

Result 


out Natural); 
in List; 
out Boolean); 
in List; 
out Item) ; 
in List; 
out List); 


procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Construct 

Set_Head 

SwapJTail 


{FronuThe_Lis t 
To„The_List 
{The_List 
{The_Item 
And_The_Lis t 
(Of_The_List 
To_The_Item 
{Of_The_List 
And_The_List 


in List; 
in out List); 
in out List); 
in I tern; 
in out List); 
in out List; 
in Item); 
in out List; 
in out List); 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace functions 


procedure Is_Equal 
procedure Length^Of 


(Left 

Right 

Result 

(The_List 


in List; 
in List; 
out Boolean); 
in List; 


end of modification 


function Is_Equal (Left 
Right 

function Length_Of (The_List 
function IsJJull (The_List 
function Head_Of (The_List 
function Tail_Of (The_List 


in List; 

in List) return Boolean; 
in List) return Natural; 
in List) return Boolean; 
in List) return Item; 
in List) return List; 


Overflow : exception; 
List_Is_Null : exception; 

private 

type Node; 

type List is access Node; 
Null_List : const 2 int List ;= null; 
end List_Single_UrLboundedJHanaged; 
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LIST SINGLE UNBOUNDED MANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874) 

with Storage_Manager_Sequential; 

package body List_Single_Unbounded_McUiaged is 

type Node is 
record 

The_Item : Item; 

Next : List; 
end record; 

procedure Free {The_Node : in out Node) is 
begin 

null ; 
end Free; 

procedure Set_Next (The_Node : in out Node; 

To^Next : in List) is 

begin 

The_Node .Next := To_Next; 
end Set_Next; 

function Next_Of (The_Node : in Node) return List is 
begin 

return The^ode.Next; 
end Next_Of; 

package Node_Manager is new Storage_Jlanager_Sequential 

(Item -> Node, 

Pointer -> List, 

Free => Free, 

Set_Pointer => SetJiJext, 

Pointer_0£ => Next^Of) ; 

procedure Copy (Front.The_List : in List; 

To_The_List : in out List) is 
Front.Index : List := From_The_List ; 

To_Index : List ,- 
begin 

Node_Manager.Free(To_The_List); 
if From_The_List /= null then 

To_The_List := NodeJManager.New_Item; 
To_The_List.The_Item ;= From_Index.The_Item; 
To_Index := To_The_List; 

From_Index := Fron\_Index.Next; 
while From_Index /= null loop 

To_Index.Next := Node_^anager.New_Item; 
To_Index := To_Index.Next; 

To_Index.The_It€m ;= FroituIiidex.The_Item; 
From_Index := FronuIndex.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_List : in out List) is 
begin 

Node ^Manager.Free(The_List); 
end Clear; 

procedure Construct (The^Item : in Item; 

And_The_List : in out List) is 
Tenporary_JIode : List; 
begin 

Tenporary_Node Node_Manager .New_Item; 

Temperary_JNode. The^Itern ; = The_Itern; 

TemporaryJTode. Next : = And_The_Lis t; 

And^The_List := Tenporary_Node; 
exception 

when Storage_Error => 
raise Overflow; 
end Construct; 

procedure Set^Head (Of_The_List : in out List; 

To_The_Item : in Item) is 

begin 

Of_The_List.The_Item := To_The_Item; 
exception 

when Constraint_Error => 
raise List_Is_JIull; 
end Set_Head; 

procedure Swap_Tail {Of_The_List : in out List; 

And_The_List : in out List) is 


TemporaryJJode : List; 
begin 

Tenporary_Node : = Of_The_List. Next; 

Of_The_List.Next ;= And_The_List; 

And_The_List := Tenporary_Node; 
exception 

when Constraint_Error => 
raise List_Is„Null; 
end Swap_Tail; 

— modified by Vincent Hong and Tuan Nguyen 

date: 9 April 1995 

— adding procedures to replace f\inctions 

procedure Is_Equal (Left : in List; 

Right : in List; 

Result : out Boolean) is 

begin 

Result := Is_Equal (Left,Right); 
end Is_Equal; 

procedure Length^Of (The_List : in List; 

Result : out Natural) is 

begin 

Result := Length^Of (The_List); 

end Length_Of; 

procedure Is_Null {The„List : in List; 

Result : out Boolean) is 

begin 

Result := Is_Null (The^List); 

end Is_Null; 

procedure Head_Of {The_List : in List; 

Result : out Item) is 

begin 

Result := Head^Of (The_List); 

end Head_Of; 

procedure Tail^Of (The_List : in List; 

Result : out List) is 

begin 

Result := Tai1_0f (The_Lis t); 

end Tail_Of; 

— end of modification 

f\mction Is_Egual (Left : in List; 

Right : in List) return Boolean is 
Left_Index : List := Left; 

Right_Index : List := Right; 
begin 

while Left_Index /= null loop 

if Left_Index.The_Item /= Right_Index.The_Item then 
return False; 
end if; 

Left_Index Left_Index.Next; 

Right_Index ;= Right_Index.Next; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is^Equal; 

f\anction Length_Of (The_List : in List) return Natural is 
Count : Natural := 0; 

Index : List := The_List; 

begin 

while Index /= null loop 
Count := Count + 1; 

Index := Index,Next; 
end loop; 
return Count; 
end Length_Of; 

function IsJNull (The_List : in List) return Boolean is 
begin 

return (The_List = null); 
end Is^ull; 

function Head_Of (The_List : in List) return Item is 
begin 

return The^List .The_Item; 
exception 

when Constraint_Error => 
raise List_Is^ull; 
end Head^Of; 

function Tail^Of (The_List : in List) return List is 
begin 

return The_List.Next; 
exception 

when Constraint_Error => 
raise List_Is_JJull; 
end Tail_Of; 

end Lis t_S ingle_Unbounded_Managed; 
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UST SINGLE UNBOUNDED MANAGED 


PSDL 


lYPE List_Single_UnboundecLMan.aged 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TyPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroitL.The_List : List, 

To_'nie_List : List 
OUTPUT 

To_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_List : List 
OUTPUT 

The_List : List 
EXCEPTIONS 

Overflow, List_IsJJull 

END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_I tem : I tern, 

AndLThe_List ; List 
OUTPUT 

And^The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Set^ead 
SPECIFICATION 
INPUT 

OfJThe^List : List, 

To_'nie_Item : Item 
OUTPUT 

Of_Ilie_List ; List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List : List, 

AncLThe„List : List 
OUTPUT 

Of_The_List : List, 

And_The_List ; List 
EXCEPTIONS 

Overflow, List_ls_Null 


END 

OPERATOR Is^Equal 

SPECIFICATION 

INPUT 

Left : List, 

Right : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The^List ; List 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR IsJIull 

SPECIFICATION 

INPUT 

The_List ; List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Head^Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result ; Item 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Tail_Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : List 
EXCEPTIONS 

Overflow, List_IsJNull 

END 


END 

IMPLEMENTATION ADA List_Single_Unbounded_Managed 
END 
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LIST SINGLE UNBOUNDED UNMANAGED 
ADA SPECIFICATIONS 


generic 

type Item is private; 

package List_Single_Unbounded_Uninanaged is 
type List is private; 


procedure Is_Null 
procedure Head_Of 
procedure Tail_Of 


(The^List 

Result 

(The^List 

Result 

(The_List 

Result 


in List; 
out Boolean); 
in List; 
out Item); 
in List; 
out List); 


Null_List : constant List; 


end o£ modification 


procedure Copy (Froit\_The_List 

To_The_List 

procedure Clear {The_List 

procedure Construct (The_Item 

And_The_List 

procedure Set_Head (of_The_List 
To_The_Item 


in List; 
in out List); 
in out List); 
in I tern; 
in out List); 
in out List; 
in Item); 


function ls_Equal (Left 
Right 

function Length_Of (The_List 
function Is^ull (The_List 
function Head_Of (The^List 
fxinction Tail_Of (The^List 


: in List; 

: in List) return Boolean; 
; in List) return Natural; 
: in List) return Boolean; 
: in List) return Item; 

; in List) return List; 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace functions 


procedure Is_Equal 
procedure Length_Of 


{Left 

Right 

Result 

(The_List 

Result 


in List; 
in List; 
out Boolean); 
in List; 
out Natural); 


Overflow : exception; 

List_Is_Null : exception; 

private 

type Node; 

type List is access Node; 
Null^List ; constant List ;= null; 
end List_Single_Unbounded_Unmanaged; 
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LIST SINGLE UNBOUNDED UNMANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial NToiober 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Con^puter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Cotirt, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


procedure Is_Equal 


begin 

Result := Is_Equal 
end Is_Equal; 


(Left 

Right 

Result 


in List; 
in List; 
out Booleeui) is 


(Left,Right); 


procedure Length_Of (The_List : in List; 

Result : out Natural) is 

begin 

Result := Length._Of (The_List); 

end Lengthu_Of; 


package body List_Single_Unbounded_Unmanaged is 

type Node is 
record 

The_Item : I tern; 

Next : List; 
end record; 


procedure Copy {FronuThe_List ; in List; 

To_The_List : in out List) is 

Fronulndex : List := FroirL_The_List; 

To_Index ; List; 
begin 

if FroiiL.The_List = null then 
To_The_List := null; 

else 

To_The_List := new Node' (The_Itern => FronuIndex.The_Item, 

Next => null); 


To_lndex ;= To__TheJList; 

Fronuindex :== FroitL.Index.Next; 
while From^Index /= null loop 

To_Index.Next := new Node*(The_Itern 
From_lndex. The_Item, 


Next 


null); 


To_Index To_Index.Next; 

Fronuindex := FronuIndex.Next; 
end loop; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_List ; in out List) is 
begin 

The^List := null; 
end Clear; 


procedure ls_Null 
begin 

Result := Is_Null 
end Is^ull; 

procedure Head_Of 

begin 

Result :- Head_0f 
end Head_0f; 

procedure Tail_Of 

begin 

Result := Tail_Of 
end Tail_0f; 

end of modification 


(The_List : in List; 

Result : out Boolean) is 

{The_List); 


(The^List : in List; 
Result : out Item) is 

(The_List); 


(The_List : in List; 
Result : out List) is 

{The_List); 


function Is_Equal (Left : in List; 

Right : in List) return Boolean is 
Left_Index : List := Left; 

Right„Index : List ;= Right; 
begin 

while Left_Index /= null loop 

if Left_Index,The_Item /= Right_Index.The_Item then 
return False; 
end if; 

Left_lndex Left_Index.Next; 

Right_Index := Right_Index,Next; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 


procedure Construct (The_Item : in Item; 

And_The_List : in out List) is 

begin 

And_The_List := new Node ‘ {The_Itern => The_Item, 

Next -> And^The^List); 

exception 

when Storage_Error => 
raise Overflow; 
end Construct; 

procedure Set^ead (Of_The_List : in out List; 

To_The_Item : in Item) is 

begin 

Of_The_List.The_Item := To_The_Item; 
exception 

when Constraint_Error => 
raise List_IsJIull; 
end Set^ead; 

procedure Swap_Tail (Of_The_List : in out List; 

And_The_List : in out List) is 
TemporaryJJode : List; 
begin 

Temporary_Node := Of„The__List.Next; 

Of_The_List.Next := And_The_List; 

And_The_List := Teit53orary_Node ; 
exception 

when Constraint_Error => 
raise List_Is_Null; 
end Swap_Tail; 

modified by Vincent Hong and Tuan Nguyen 
date: 9 April 1995 

adding procedures to replace functions 


fianction Length^Of (The_List : in List) return Natural is 
Count : Natural ;= 0; 

Index : List := The_List; 
begin 

while Index null loop 
Count := Count + 1; 

Index := Index,Next; 
end loop; 
return Count; 
end Length_Of; 

function IsJMull (The_List : in List) return Boolean is 
begin 

return (The_List = null); 
end ls_Null; 

function Head_Of (Tfae_List : in List) return Item is 
begin 

re turn The^Lis t. *rhe_I t em ; 
exception 

when Constraint_Error => 
raise List_IsJ^ull; 
end Head_0f; 

function Tail^Of (The_List : in List) return List is 
begin 

return The_List.Next; 
exception 

when Constraint_Error => 
raise List_Is^ull; 
end Tail_Of; 

end List_Single_Unbounded_Unmanaged; 
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LIST SINGLE UNBOUNDED UNMANAGED 


PSDL 


TYPE List_Singlejanboundec3UUninanaged 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Froit\_The_List : List, 
To_TheJList ; List 
OUTPUT 

To_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The^List : List 
OUTPUT 

The_List : List 
EXCEPTIONS 

Overflow, List_IsJNull 

END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_Item : Item, 

And_The_List : List 
OUTPUT 

And^The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 


Right : List 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Length^Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Is_Null 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Boolecin 
EXCEPTIONS 

Overflow, List_Is_Null 

END 

OPERATOR Head^Of 

SPECIFICATION 

INPUT 

The_List : List 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, List_Is_Null 

END 


OPERATOR Set^ead 
SPECIFICATION 
INPUT 

Of_The_List : List, 
To_The_ltem ; Item 
OUTPUT 

Of_The_List : List 
EXCEPTIONS 

Overflow, List_Is_Null 

END 


OPERATOR Tail_Of 
SPECIFICATION 
INPUT 

The_List : List 
OUTPUT 

Result : List 
EXCEPTIONS 

Overflow, List^IsJWull 

END 


OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : List, 


END 

IMPLEMENTATION ADA List_Single_Unbounded„Unmanaged 
END 
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MAP SIMPLE NONCACHED SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Domain is private; 
type Ranges is private; 

with fLinction Hash_Of (The^Domain ; in Domain) return Positive; 

— modified by Tuan Nguyen and Vincent Hong 

“ date: 8 April 1995 

adding procedures to replace functions 

with procedure Hash_Of (The__Domain : in Domain; 

Result : out Positive); 

— end of medication 

package Map„Siitple_Noncached_Sequential_BoundedLJlanaged_Iterator is 

type Map(The„Size : Positive) is limited private; 

procedure Copy (FronuThe_Map : in Map; 

To_TheJMap : in out Map); 

procedure Clear (The^Map : in out Map); 

procedure Bind {The__Domain : in Domain; 

And_The_Range : in Ranges; 

In_The_Map : in out Map) ; 

procedure Unbind (The_Doinain : in Domain; 

In_The^ap ; in out Map); 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

adding procedures to replace functions 

procedure Is_Equal (Left : in Map; 

Right : in Map; 

Result : out BoolCcin) ; 
procedure Extent_Of (The_Map ; in Map; 

Result : out Natural); 

procedure Is_Enpty (The_Map : in Map; 

Result : out Boolean); 
procedure Is^Bound (The_Domain ; in Domain; 

IrL_The_Map : in Map; 

Result : out Boolean); 


procedure Range_Of (The_Domain : in Domain; 

In_TheJMap : in Map; 

Result : out Ranges); 

— end of modication 

f\mction Is_Egual (Left : in Map; 

Right : in Map) return Boolean; 

function Extent_Of {The_Map : in Map) return Natural; 

function Is^Enpty (The_Jlap : in Map) return Boolean; 

function Is^Boxind {The_,Domain : in Domain; 

In_The_JMap : in Map) return Boolean; 
function Range_Of {The_Domain : in Domain; 

In_The_Map : in Map) return Ranges; 

generic 

with procedure Process (The_Domain ; in Domain; 

The_Range : in Ranges; 

Continue : out Boolean); 

procedure Iterate (Over_The_Map : in Map); 

Overflow : exception; 

Doinain_ls_Mot_Bo\md : exception; 

Multiple_Binding : exception; 

private 

type State is (Ertpty, Deleted, Bound) ; 
type Node is 
record 

The_State ; State := Enpty; 

The_Domain : Domain; 

The_Range : Ranges; 
end record; 

type Items is array (Positive range <>) of Node; 
type Map(The_Si 2 e : Positive) is 
record 

The_Items : Items(1 .. The_Size); 

The_Count : Natural := 0; 
end record; 

end Map_Siinple_MoncachecLSequential_BoundedJManaged_Iterator 
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MAP SIMPLE NONCACHED SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nvunber 0100219 


end if; 
exception 

when Constraint_Error => 
raise Overflow; 
end Bind; 


-Restricted Rights Legend" 

Use, duplication, or disclosure is s^Ibject to 

— restrictions as set forth in subdivision (b) (3) {ii) 

— of the rights in Technical Data and Coit 5 )uter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Map_Siinple_Noncached_Sequential_Bounded_Managed_Iterator 
is 


procedure Find (The_Domain : in Domain; 

In^TheJMap : in Map; 

The^Bucket : out Natural) is 
Initial_Probe : Natural := 

Hash_0f(The_Domain) mod 

In_The_Map.The_Size; 

Terrporary_Index : Positive; 

Temporary_Bucket : Natural; 
begin 

Ten:^orary_3ucket := 0; 

for Index in IrL_TheJMap.The_Iterns'Range loop 
Temporary_Index : = 

((Index + Initial_Probe - 2) mod In_The_^ap.The_Size) + 


1 ; 

case ln_The,^p.The_lterns(Temporary^Index) .The_State is 
when Empty => 

if Temperary_Bucket = 0 then 

Temperary_Bucket := Temporary_Index; 
end if; 

The^Bucket Tenporary^Bucket; 
return; 

when Deleted => 

if Temperary_Bucket *= 0 then 

Teirporary_Bucket := Teiiporary_Index ; 
end if; 

when Bound => 
if 

Injrhe_Map. The_I terns (TeiTporary_Index) . The_Doma in = 

~ The_Domain then 

The_Bucket := Tenporary_Index; 
retum; 
end if; 


end case; 
end loop; 

The^Bucket ;= Tenporary_Bucket; 
end Find; 


procedure Copy (From_The_Map : in Map; 

To_The_Jlap ; in out Map) is 
The_Bucket : Natural; 
begin 

if FronL.The_Map.The_Count > To_The_Map.The_Size then 
raise Overflow; 

else 

for Index in To_The^ap-The_Iterns'Range loop 

To_The_Map. The_I terns (Index) . The_S tat e : = Enp ty ; 
end loop; 

To_The_Map.The_Count := 0; 

for Index in FroituThe_Jtap.The_Items'Range loop 

if FronL.TheJlap.The_Items(Index) .The_State = Bound 
i 

Find (FronL_The_Map. The_Iterns (Index) . The_Domain, 
To_The_Map, The_Bucket); 

To_The_Map.The_Iterns(The_Bucket) : = 
From_The_Map.The_Items(Index); 
end if; 
end loop; 

To_The_Map. The_Count : = From_The_Map. The_Coiint; 
end if; 
end Copy; 

procedure Clear (The_Map : in out Map) is 
begin 

for Index in The_Map.The_Iterns'Range loop 

The_Map.The_Iterns (Index) .The_State := Empty; 
end loop; 

TheJMap.The_Count 0; 
end Clear; 

procedure Bind (The^Domain : in Domain; 

And_The_Range : in Ranges; 

In_The_Map ; in out Map) is 

The_Bucket : Natural; 
begin 

Find (The_Doina in, In_The_Map, The_Bucke t) ; 

if In_The_Map.The_Items(The_Bucket) .The_State = Bound then 
raise Multiple_Binding; 
else 

In^TheJMap. The_Items (The^Bucket) : = 

Node'(Bound, The_Domain, And_The_Range) ; 
In_The_Map.The_Cotxnt In_The_Map.The^Count + 1; 


procedure Unbind (The_Domain : in Domain; 

In_lhe_Map : in out Map) is 
The^Bucket : Natural; 
begin 

Find(The_Doinain, In_The_Map, The_Bucket) ; 

if In_The_Map.The_Items(The„Bucket).The_State = Bound then 
In_The_Map.The_Items{The_Bucket) .The_State Deleted; 
In_The_Map.The_Count := In_The_Map.The^Coiint - 1; 

else 

raise Domain_Is_Not_Bound; 
end if; 
exception 

when Constraint_Error => 

raise Domain_Is_Not_Bound; 
end Unbind; 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

— adding procedures to replace functions 

procedure Is_Equal (Left : in Map; 

Right : in Map; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent_0f {The_Map ; in Map; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Map); 
end Extent_0f; 

procedure Is_Eirpty (The_Map : in Map; 

Result : out Boolean) is 

begin 

Result Is_Enpty(The_Map) ; 
end Is_Ertpty; 

procedure Is_Bound (The_Domain : in Domain; 

In_TheJlap ; in Map; 

Result : out Boolean) is 

begin 

Resul t : = Is_Bo\ind (The_Domiain, In_The JMap) ; 
end Is_BOTmd; 

procedure Range^Of (The_Domain : in Domain; 

In_The_Map : in Map; 

Result : out Ranges) is 

begin 

Result := Range_Of (The_Domain, In„The^Map) ; 
end Range^Of; 

— end of modification 


fimction Is_Equal (Left : in Map; 

Right : in Map) return Boolean is 
Temporary_Index : Natural; 
begin 

if Left .The_Coimt /= Right.The_Count then 
return False; 

else 

for Index in 1 .. Left.The_Size loop 

if Left ,The_Iterns (Index) .The_State - Bound then 
Teirporary_Index rss 0; 

for Inner_Index in 1 .. Right,The_Size loop 

if (Right.The_Items(Index).The_State = Bound) 

and then 

(Left. The_I terns (Index) . The_Domain = 

Right .The_Iterns (Inner_Index) .The_Domain) 

then 

Teirporary_Index := lnner_Index; 
exit; 
end if; 
end loop; 

if Left.The_Iterns (Index) .The^Range /= 

Right .The„Iterns (Temperary^Index) .The_Range then 
return False; 
end if; 
end if; 
end loop; 
return True; 
end if; 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

fxanction Extent_Of (Thejlap : in Map) return Natural is 
begin 

return The_Map. The_Count ; 
end Extent_Of; 
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function Is_E[r5>ty {The_Wap : in Map) return Boolean is 
begin 

return {The_jMap.The_Count = 0); 
end Is_Eit 5 >ty; 

function Is__Bound (The_Domain : in Domain; 

InJThejaap : in Map) return Boolean is 
The_Bucket : Natural; 
begin 

Find(TheJDomain, In_The_Map, The_Bucket); 

return (ln_The_Map.The_Iterns(The^Bucket) .The_State = Bound); 
exception 

when Constraint_Error => 
return False; 
end IsJBo\md; 

function Range_Of (The_Domain : in Domain; 

In_The_Map : in Map) return Ranges is 
The_Bucket : Natural; 
begin 

Find(The_Domain, In_The_Map, The_Bucket); 

if In_The_Map.The_Iterns(The_Bucket).The^State = Bound then 


return In_The.Jlap. The_Iteins (The_Bucket) . The^Range ; 

else 

raise Domain^IsJJot_Bound; 
end if; 
exception 

when Constraint_Error => 

raise Doinain«.Is_Not_Bound; 
end Range_Of; 

procedure Iterate {Over_TheJlap : in Map) is 
Continue : Boolean; 
begin 

for Index in Over_TheJIap.The_Iterns'Range loop 

if Over_The_Map-The_Iterns (Index) .The_State = Bound then 
Process(Over^TheJIap.The_Iterns(Index).The_Domain, 
Over_The_Map.The_Iterns(Index).The_Range, 
Continue); 

exit when not Continue; 
end if; 
end loop; 
end Iterate; 

end Map_Siiiple_Noncached_Seguential_Bounded_Managed_Iterator; 
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MAP SIMPLE NONCACHED SEQUENTIAL BOUNDED MANAGED ITERATOR 

PSDL 


TYPE Map_Siii:5)leJNoncached_Se<3uential_Bo\mdedJlanaged_Iterator 
SPECIFICATION 
GENERIC 

Domain : PRIVATE_TYPE, 

Ranges ; PRIVATE_TYPE, 

Hash_Of : FUNCTION[The_Domain : Domain, RETURN ; Positive], 
HasluOf : PROCEDURE[The_Domain : in[t : Domain], Result : out[t : 
Positive]] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuTheJMap : Map, 

To_The_Map : Map 
OUTPUT 

To^TheJlap : Map 
EXCEPTIONS 

Overflow, Domain„Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The^Map : Map 
OUTPUT 

The_Map ; Map 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Bind 
SPECIFICATION 
INPUT 

The_Domain ; Domain, 

AnoLThe_Range : Ranges, 

In_TheJMap : Map 
OUTPUT 

In„The_Map : Map 
EXCEPTIONS 

Overflow, Doinain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Unbind 
SPECIFICATION 
INPUT 

The^Domain ; Domain, 

In-.The Jlap : Map 
OUTPUT 

In_The_Jlap : Map 
EXCEPTIONS 

Overflow, Domain_IsJTot_^Bo\jnd, Multiple_Binding 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Map, 

Right : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 


Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Extent^Of 

SPECIFICATION 

INPUT 

The^ap : Map 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Is_Einpty 

SPECIFICATION 

INPUT 

Thejrtap : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Doniain_Is_Not_Botind, Multiple_Binding 

END 

OPERATOR Is^Bound 

SPECIFICATION 

INPUT 

The_Doinain : Domain, 

In_The_Map : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Range_Of 

SPECIFICATION 

INPUT 

The^Domain ; Domain, 

In_The,JIap : Map 
OUTPUT 

Result : Ranges 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process ; PROCEDUREIThe_Domain : in[t : Domain], The_Range 
in[t : Ranges], Continue : out[t : Boolecin] ] 

INPUT 

Over_The_Jiap : Map 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

END 

IMPLEMENTATION ADA 

Map_Sin5}le_Noncached_Se<3uential„Bounded_Managed_Iterator 

END 
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MAP SIMPLE NONCACHED SEQUENTIAL BOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Domain is private; 
type Ranges is private; 

Number_Of_Bvickets : in Positive; 

with function Hash_Of (The„Domain : in Domain) return Positive; 

— modified toy Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

adding procedures to replace functions 

with procedure Hash_Of (The_Domain : in Domain; 

Result : out Positive); 

— end of modication 

package Map_SirpleJ3oncached^Sequential_Unbounded_Managed_JJoniterator 
is 

type Map is limited private; 

procedure Copy (From^TheJUap : in Map; 

To^TheJMap : in out Map); 

procedure Clear (The_Map : in out Map); 

procedure Bind (The^Domain : in Domain; 

And_The_Range : in Ranges; 

In_The_Map : in out Map) ; 

procedure Unbind (The^Domain : in Domain; 

In_TheJIap : in out Map); 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

— adding procedures to replace functions 
procedure Is_Equal (Left : in Map; 


Right : in Map; 

Result : out Boolean); 
procedure ExtentjOf (The_Map : in Map; 

Result : out Natural); 

procedure Is_Enpty (TheJMap : in Map; 

Result : out Boolean) 
procedure Is_Bound {The_Domain ; in Domain; 

In_The_Map : in Map; 

Result : out Boolean); 

procedure Range__Of {The_Domain : in Domain; 

Ii;_TheJIap : in Map; 

Result : out Ranges); 

— end of modication 

function Is_Equal (Left : in Map; 

Right : in Map) return Boolean; 

function Extent_Of (The_Map : in Map) return Natural; 

function Is_Enpty (TheJMap : in Map) return Boolean; 

function Is_Boimd {The_Domain ; in Domain; 

In_TheJlap : in Map) return Boolean; 
function Range_Of (The_Domain : in Domain; 

In_The_Map : in Map) return Ranges; 

Overflow : exception; 

Domain_IsJMot_Bound : exception; 

Multiple_Binding : exception; 

private 

type Node; 

type Structure is access Node; 

type Map is array (Positive range 1 .. Nuinber_Of_Buckets) of 
Structure; 

end Map_Siinple_Noncached_Seguential_UnboundedLManagecUJoniterator 





MAP SIMPLE NONCACHED SEQUENTIAL BOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 
--All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is sijbject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Con 5 >uter 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential; 

package body , • * 

Map__Sinple_Noncached_Sequential_Unbounded_Jlanaged_Noniterator is 


type Node is 
record 

The_Domain : Domain ; 

The^Range : Ranges; 

Next : Structure; 

end record; 

procedure Free (The^ode : in out Node) is 
begin 

null; 
end Free; 


procedure Set_Next (The_Node : in out Node; 

ToJMext : in Structure) is 

begin 

TheJJode.Next := To_Next; 
end Set_Next; 

function Next_Of (The^ode : in Node) return Structure is 
begin 

return The_Node.Next; 
end Next^Of; 


package Node_Manager is new Storage_Kanager_Seguential 

(Item => Node, 

Pointer => Structure, 
Free => Free, 

Set_Pointer => SetJtJext, 
Pointer_Of => Next_Of); 


procedure Find (The_Doinain : in Domain; 

In_TheJMap : in Map; 

The_Bucket : out Positive; 

Previous_Node : in out Structure; 

Current_Node : in out Structure) is 

Teii 5 )orary_Bucket ; Positive : = 

(Hash_Of (The^Domain) mod 

Nuinber_Of_Buckets) + 1 ; 
begin 

The_Bucket := Teirporary_Bucket; 

Current_Node := In_The_Map(Tenporary_Bucket) ; 
while Current_Node /= null loop 

if Current_Node.The^Domain = The_Domain then 
return; 

else 

Previous_Node := Current J^ode; 

Current JNode := Current„Node.Next; 
end if; 
end loop; 
end Find; 


procedure Clear (TheJIap : in out Map) is 
begin 

for Index in The^ap* Range loop 

NodeJManager. Free (The_Map (Index)) ; 
end loop; 
end Clear; 


procedure Bind (The^Domain : 

And_The_Range : 
In_The_Map : 

The_Bucket ; Positive; 

PreviousJMode : Structure; 
CurrentJWode : Structure; 
Tenporary JNode ; Structure; 
begin 

Find(The_Domain, InJThe^Map, 
Current_Node) ; 

if Current_Node /= null then 
raise Multiple_Binding; 


in Domain; 
in Ranges; 
in out Map) is 


The^Bucket, Previous_Node, 


else 

Teirporary_Node := Node_Manager .New_Item; 

TemperaryJNode.The_Domain := The_Domain; 
Temporary_Node.The_Range := And^The_Range; 
TernporaryJNode. Next : - In_The_Map (The^Bucket); 
IruTheJ!ap {The^Bucke t) : = Tenporary^ode ; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Bind; 


procedure Unbind (The^Domain ; in Domain; 

In_The_Map ; in out Map) is 
The^Bucket ; Positive; 

PreviousJlode : Structure; 

Current_Node : Structure; 
begin 

Find(The_Domain, In_TheJIap, The_Bucket, Previous^Node, 
Current_Node); 

if Previous_Node * null then 

In_The_Map (The_Bucket) := Current_Node.Next; 

else 

Previous_Node.Next := Current^Node.Next; 
end if; 

Current JNode.Next := null; 

NodeJManager.Free(Current^Node); 
exception 

when Constraint_Error => 

raise Doinain_Is_Not_,Bound; 
end Unbind; 


— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

adding procedures to replace functions 

procedure Is_Ec[ual (Left : in Map; 

Right : in Map; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Map : in Map; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Map); 
end Extent_Of; 


procedure Copy (From_The_Map : in Map; 

To_The_Map : in out Map) is 
Fronjlndex : Structure; 

To_Index : Structure; 
begin 

for Index in To_The_Map'Range loop 

Node_^lanager. Free {To_The^ap (Index)) ; 
end loop; 

for Index in FroitL_TheJlap ’ Range loop 
From__Index := FroiiL_The_Map (Index) ; 
if From_The_Map(Index) /= null then 

To_The_Map(Index) Node^Meinager .New_Item; 

To_TheJlap (Index) . The_Domain : = From_Index. The_Domain; 
To_TheJX(ap (Index) . The_Range : = From_Index. The_Range ; 
To_Index : = To_The_Map {Index) ; 

From_Index := FronuIndex.Next; 
while From_Index /= null loop 

To_Index,Next := Node_Manager.New_Item; 
To_Index.Next.The_Domain := From_Index.The_Domain; 
To_Index.Next.The_Range := From_Index,The_Range; 
To_lndex : = To_Index. Next; 

From_Index ;= From_Index.Next; 
end loop; 
end if; 
end loop; 
exception 

when Storage_Error »> 
raise Overflow; 
end Copy; 


procedure Is_En^ty (The_Map : in Map; 

Result : out Boolean) is 

begin 

Result := Is_Empty{TheJlap); 
end Is_Enpty; 

procedure Is_Bovind (The^Domain : in Domain; 

In_The_Map : in Map; 

Result ; out Boolean) is 

begin 

Result := Is_Bound(The^Domain,Injrhe_Map); 
end Is_Bound; 

procedure Range_Of (The_Domain : in Domain; 

In_The_Map : in Map; 

Result : out Ranges) is 

begin 

Result := Range_Of (The_Domain,In_The_Map); 
end Range_Of; 

end of modification 

function Is_Egual (Left : in Map; 

Right : in Map) return Boolean xs 
Left_Index : Structure; 

Right^Index : Structure; 

Left_Count : Natural; 

Right_Count : Natural; 
begin 
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for Index in Left'Range loop 

if (Left(Index) = null) xor (Right(Index) = null) then 
return False; 

else 

Left^Index := Left(Index); 

Left_Count ;= 0; 

while Left_Index t- null loop 

Rigiit-Index := Right (Index) ; 
while Right_Index /= null loop 
if (Left_Index.The_Domain = 

Ri ght_Index. The_Doina in) then 
exit; 

else 

Right_Index := Right_Index,Next; 
end if; 
end loop; 

if Left_Index.The_Range /= Right^Index.The^Range 

then 

return False; 

else 

Left_Index := Left^Index.Next; 

Left_Count := Left_Count + 1; 
end if; 
end loop; 

Right_Index :ss Right (Index) ; 

Right_Coiint := 0; 

while Right_Index /= null loop 

Right_Index := Right_Index.Next; 

Right_Count := Right_Count + 1; 
end loop; 

if Left_Co\int /= Right_Count then 
return False; 
end if; 
end if; 
end loop; 
return True; 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

ftinetion Extent_Of (The,Jlap : in Map) return Natural is 
Count : Natural := 0; 


Teniporary^Node : Structure; 
begin 

for Index in TheJlap' Range loop 

Tenporary_Node : = The__Map (Index) ; 
while Teinporary^ode /= null loop 
Count ;= Count + 1; 

TenporaryJNode ; = Tewporary^ode. Next ; 
end loop; 
end loop; 
return Count; 
end Extent^Of; 

ftinction Is_Eitpty (The^Nap : in Map) return Boolean is 
begin 

return (TheJMap = Map'(others => null)); 
end Is_Enpty; 

function Is_Bound (The_Doinain : in Domain; 

In_The_Jlap : in Map) return Boolean is 
The_Bucket : Positive; 

Previous_Node : Structure; 

Current_Node : Structure; 
begin 

Find{The_Domain, In_The_Mapy 'Ihe_Bucket, Previous_Node, 
CurrentJJode); 

return (Current^ode /= null); 
end Is_Bound; 

function Range_Of (The_Domain : in Domain; 

In_The_Map : in Map) return Ranges is 
The^Bucket ; Positive; 

Previous_Node ; Structure; 

Current_^ode : Structure; 
begin 

Find(The_Domain, In_The_Map, The_Bucket, PreviousJNode, 
CurrentJJode); 

return CurrentJJode.The_Range; 
exception 

when Constraint_Error => 

raise Doinain_Is_Not_Bound; 
end Range_0f; 

end Map_Siinple_Noncache<l_Sequential_UnboundedJlanaged_Noniterator 
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MAP SIMPLE NONCACHED SEQUENTIAL BOUNDED MANAGED NONITERATOR 

PSDL 


TyPE Map_Siinple^oncached_Se<3uential_Unbounded_ManagedJIoniterator 
SPECIFICATION 
GENERIC 

Domain : PRIVATE_TYPE, 

Ranges : PRIVATE_TyPE, 

Hash_Of : FUNCTION[The^Domain : Domain, RETURN ; Positive], 
Hash_Of : PROCEDURE[The^Domain : in[t : Domain], Result : out[t : 
Positive]] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuTheJMap : Map, 

To_The_Map : Map 
OUTPUT 

To„The_Map : Map 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_,Binding 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

Thejlap ; Map 
OUTPUT 

Thejlap : Map 
EXCEPTIONS 

Overflow, Domain_IsJMot_Bound, Multiple_Binding 

END 

OPERATOR Bind 
SPECIFICATION 
INPUT 

The_Doinain : Domain, 

And_The_Range ; Ranges, 

In_The_^ap : Map 
OUTPUT 

In_TheJMap : Map 
EXCEPTIONS 

Overflow, Domain_IsJ^ot_Bound, Multiple_Binding 

END 

OPERATOR Unbind 
SPECIFICATION 
INPUT 

The_Domain ; Domain, 

In_The_^p : Map 
OUTPUT 

In_The_Map : Map 
EXCEPTIONS 

Overflow, Domain_Is_JIot_Bound, Multiple_Binding 

END 

OPERATOR Is^Equal 
SPECIFICATION 
INPUT 


Left : Map, 

Right : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bo\md, Multiple_Binding 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Map ; Map 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Is_Empty 

SPECIFICATION 

INPUT 

The_Map ; Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domainals_Not_Bound, Multiple_Binding 

END 

OPERATOR Is^Bound 

SPECIFICATION 

INPUT 

The_Doinain : Domain, 

In_TheJMap : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Doinain_Is_Not_Bo%ind, Multiple_Binding 

END 

OPERATOR Range_Of 

SPECIFICATION 

INPUT 

The_Domain ; Domain, 

In^The_JIap ; Map 
OUTPUT 

Result : Reinges 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple^Binding 

END 

END 

IMPLEMENTATION ADA 

Map_Simple_JJoncached_Sequential_Unbounded_ManagedJJoni tera tor 

END 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Domain is private; 
type Ranges is private; 

Nuinber_0£_Buckets : in Positive; 

with fimction Hash_Of {The_Domain : in Domain) return Positive; 

— modified by Tuan Nguyen and Vincent Hong 

— date; 8 April 1995 

adding procedures to replace functions 

with procedure Hash_0£ (The_Doinain : in Domain; 

Result : out Positive); 

— end of modication 

package Map_Sin?>le_NoncachecLSequential_UnboundedJIanaged_Iterator is 

type Map is limited private; 

procedure Copy (From_The_Nap 
To_The_JMap 

procedure Clear (The_Nap 
procedure Bind (The_Domain 

Andjrhe_Range 
In_The_Map 
procedure Unbind (The_Domain 
InL_TheJlap 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

— adding procedures to replace f\inctions 

procedure Is_Equal (Left ; in Map; 

Right : in Map; 

Result : out Boolean); 
procedure Extent_Of (Thejfap ; in Map; 

Result : out Natural); 


: in Map; 

: in out Map) ; 

: in out Map); 

: in Domain; 
: in Ranges; 
; in out Map); 

: in Domain; 
: in out Map) ; 


procedure Is_Errpty (The_Map : in Map; 

Result : out Boolean); 
procedure Is_Bound (The_Domain : in Domain; 

In_The_Map : in Map; 

Result : out Boolean); 

procedure Reinge^Of (The_Domain ; in Domain; 

Injrhe_Map : in Map; 

Result : out Ranges); 

— end of modication 

function Is^Equal (Left : in Map; 

Right : in Map) return Boolean; 

function Extent_Of {The_Map : in Map) return Natural; 

function Is_Enpty {The_Map : in Map) return Boolean; 

fionction Is^ound {The_Domain : in Domain; 

In_The_Map : in Map) return Boolean; 
function Range_Of (The^Domain ; in Domain; 

In_The_Map : in Map) return Ranges; 

generic 

with procedure Process {The_Domain ; in Domain; 

The_Range ; in Ranges; 

Continue ; out Boolean); 

procedure Iterate (Over_The_Map : in Map); 

Overflow : exception; 

Domain_IsJ»ot_Bound ; exception; 

Multiple_Binding : exception; 

private 

type Node; 

type Structure is access Node; 

type Map is array (Positive range 1 . . Nuinber_Of_Buckets) of 
Structure; 

end Map_S impl e JJonc ached_Sequent i al_Unbounded_Managed_I t era tor; 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

-- Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

-- Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage.Jlanager_Sequential; 
package body 

Map_Sinple_JJoncached_Sequent ial_UnboiindedLM£inaged_I ter a tor is 

type Node is 
record 

The_Doinain : Domain; 

The_Range : Ranges; 

Next : Structure; 

end record; 

procedure Free (The_Node : in out Node) is 
begin 

null; 
end Free; 

procedure SetJtJext (The_^ode : in out Node; 

To^Next : in Structure) is 

begin 

The_Node.Next To_Next; 
end Set_Next; 

function Next_Of (The_Node : in Node) return Structure is 
begin 

return The__Node, Next; 
end Next_Of ; 

package Node_Manager is new Storage_Manager_Seguential 

(Item => Node, 

Pointer -> Structure, 

Free => Free, 

Set_Pointer => Set_Next, 
Pointer_Of => Next_Of); 

procedure Find {The_Doinain : in Domain; 

InJTheJlap ; in Map ; 

The_Bucket : out Positive; 

PreviousJJode : in out Structure; 

Current_Node ; in out Structure) is 

Temporary_Bucket : Positive 

(Hash_Of (The_Domain) mod 

Nuinber_Of_Buckets) + 1; 
begin 

The_Bucket Teirporary_Bucket ; 

Current_Node := ln^The_Map (Ten?>orary_Bucket) ; 
while Current_Node /= null loop 

if Current_Node .The_Domain = The_Domain then 
return; 

else 

Previous_Node := Current_Node; 

Current JNode := Current_Node.Next; 
end if; 
end loop; 
end Find; 

procedure Copy (From_The_Map : i^o Map; 

To_The_,Map : in out Map) is 
From_Index : Structure; 

To_Index : Structure; 
begin 

for Index in To_The_Map'Range loop 

Node_Manager.Free{To_The_Map(Index)); 

end loop; 

for Index in Froit\_The_Map' Range loop 
Fronuindex := From_The_Map(Index); 
if From_The_Map(Index) /= null then 

To_TheJ4ap( Index) := Node^Manager .New_Item; 

To_The_Map {Index) . The_Domain : = Fronuindex. The_Domain; 
To_The_Map(Index).The_Range := From_Index.The_Range; 
To_Index := To„The_Map (Index) ; 

Fronuindex := FronuIndex.Next; 
while Fronuindex /= null loop 

To_Index.Next := Node__Manager.New„Item; 
To_Index.Next.The_Domain := FronuIndex.The_Domain; 
To_Index-Next.The_Range Fronuindex.The_Range; 

To_Index := To_lndex.Next; 

Fronuindex := FronuIndex.Next; 
end loop; 
end if; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear (TheJMap : in out Map) is 
begin 

for Index in TheJSap’Range loop 

Node_Manager-Free(The„Map(Index)); 
end loop; 
end Clear; 

procedure Bind (The_Domain : in Domain; 

And_The_Range : in Reinges; 

In_The_Map : in out Map) is 

The_Bucket : Positive; 

Previous^ode : Structure; 

Current^Node : Structure; 

Tenporary_Node : Structure; 
begin 

Find(The_Domain, In_The_Map, The_Bucket, PreviousJNode, 
CurrentJJode); 

if CurrentJOfode /= null then 
raise Multiple_Binding; 

else 

Tenporary_Node ;= Node_Nanager .New_It^; 
Tenporary^Node. The^Domain : := The_Domain ; 
Tenporary_Node. The^Range ; = And_The_R£uige ; 
TenporaryJNode-Next := In_The_Map(The_Bucket); 
In_The_Jiap (The_Bucke t) : = Tertporary_Node; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Bind; 

procedure Unbind (The_Domain : in Domain; 

In_TheJMap ; in out Map) is 
The_Bucket : Positive; 

Previous_Node ; Structure; 

Current^ode : Structure ; 
begin 

Find(The„Domain, In_The_Map, The^Bucket, Previous^Node, 
Current_Node) ; 

if Previous^ode = null then 

In_The_Map (The_Bucket) := Current_Node.Next; 

else 

Previous_Node.Next ;= Current_Node.Next; 
end if; 

Current_Node.Next := null; 

Node^Manager.Free(Current_Node); 
exception 

when Constraint_Error =:> 

raise Domain_IsJNot_Bound; 
end Unbind; 

— modified by Tuan Nguyen and Vincent Hong 

— date; 8 April 1995 

— adding procedures to replace fxjnctions 

procedure Is_Equal (Left : in Map; 

Right : in Map; 

Result ; out Boolean) is 

begin 

Result ;= Is_Egual(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Map ; in Map; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Map); 
end Extent^Of; 

procedure Is^Enpty (TheJSlap ; in Map; 

Result : out Boolean) is 

begin 

Result := Is_Empty(TheJMap); 
end Is_Eitpty; 

proced\ire Is_Bound (The^Domain : in Domain; 

In_The_Nap : in Map; 

Result : out Boolean) is 

begin 

Result := Is_Bound(The_Domain,In_The^Map); 
end Is_Bound; 

procedure Range^Of (The_Doinain : in Domain; 

ln_The_Map : in Map; 

Result ; out Ranges) is 

begin 

ResuIt := Range_Of(TheJDomain,In_The_Map); 
end Range_Of; 

— end of modification 

function Is.^Equal (Left : in Map; 

Right : in Map) return Boolean is 
Left^Index ; Structure; 

Right_Index : Structure; 

Left_Count : Natural; 

Right_Co^lnt : Natural; 
begin 
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for Index in Left‘Range loop 

if (Left(Index) = null) xor (Right(Index) = null) then 
return False; 

else 

Left_Index :* Left(Index); 

Left_Count := 0; 

while Left_lndex /« null loop 

Right_Index := Right(Index); 
while Right_Index /= null loop 
if (Left_Index.The_Doinain = 

Right_Index.The_Domain) then 
exit; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Left_Index.The_Range /= Right_Index-The_Range 

then 

return False; 

else 

Left_Index := Left_Index.Next; 

Left_Count := Left_Count + 1; 
end if; 
end loop; 

Right_Index := Right(Index); 

Right_Count ;= 0; 

while Right_lndex /= null loop 

Right_Index := Right_Index.Next; 

Right_Count := Right_Count + 1; 
end loop; 

if Left_Count /= Right_Count then 
return False; 
end if; 
end if; 
end loop; 
return True; 
exception 

when Const rain t__Error => 
return False; 
end Is_Equal; 

function Extent_Of (The_Nap : in Map) return Natural is 
Count ; Natural := 0; 

Tentporau:y_Node : Structure ; 
l>egin 

for Index in The_Map'Range loop 

Teirporary_Node := The^Nap (Index) ; 
while Tenporary^ode I- null loop 
Count := Count + 1; 

Teinporai:y_JJode : = TeirporaryJMode, Next; 
end loop; 
end loop; 
return Count; 
end Extent_Of; 

function Is_Einpty (The_Map : in Map) return Boolean is 
begin 

return (TheJMap = Map'(others => null)); 


end Is^Empty; 

fianction Is_Bound (The_Pomain : in Domain; 

In_The_Nap ; in Map) return Boolean is 
The_Bucket : Positive; 

Previous_Node : Structure; 

Current^ode : Structure; 
begin 

Find(The_Domain, In_The^ap, The_Buc)cet, Previous_Node, 
CurrentJNode) ; 

return (CurrentJMode f~ null); 
end Is_Bound; 

function Range^Of (The_Doinain : in Domain; 

In_The_Map : in Map) return Ranges is 
The_Bucket : Positive; 

PreviousJlode ; Structure; 

Current_JJode : Structure; 
begin 

Find(The_Doinain, In_The_Map, The^Bucket, Previous_Node, 
Current_Node) ; 

return CurrentJJode.The_Range ; 
exception 

when Constraint_Error => 

raise Domain„Is_Not_Bo\jnd; 
end Range_0f; 

procedure Iterate (Over_.The_Jlap : in Map) is 

The_JBucket : Positive ;= Over_The_Map’Last; 

The_Node : Structure; 

Continue : Boolean; 

begin 

for The^lterator in Over_The_Map'Range loop 

if Over„The_Nap{The_lterator) /- null then 
The^Bucket ;= The_Iterator; 

The^Node := Over_The_Map(The_ltera tor); 
exit; 
end if; 
end loop; 

while The_Node /= null loop 

Process(The_Node.The_Domain, The_Node.The_Range, 

Continue); 

exit when not Continue; 

TheJ^ode := TheJNode.Next; 
if TheJNode = null then 

for The_lterator in (The^Bucket +1) .. 
Over_TheJlap'Last loop 

if Over_The_Map(The_Iterator) /= null then 
The_Bucket := The_Iterator; 

The_Node := Over_The_flap(The_Iterator) ; 
exit; 
end if; 
end loop; 
end if; 
end loop; 
end Iterate; 

end Map_,SinpleJNoncachecLSequential_Unboxanded^_Managed_Iterator; 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

PSDL 


TYPE Map_Sirnple_Noncached^Sequential_Unbounded_Managed^Iterator 

SPECIFICATION 

GENERIC 

Domain : PRIVATE_TYPE, 

Ranges : PRIVATE_TYPE, 

Hash Of ; FUNCTIONlThe_Domain ; Domain, RETURN ; Positive], 
Hashlof : PROCEDURE [The_Doinain : intt : Domain], Result : out It : 
Positive]] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

FroiruTheJMap : Map, 

To_The_JIap : Map 
OUTPUT 

To_The Jlap ; Map 
EXCEPTIONS 

Overflow, Domainals_Not_Bound, Multiple^Binding 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The^Map : Map 
OUTPUT 

The_Map : Map 
EXCEPTIONS 

Overflow, Doinain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Bind 
SPECIFICATION 
INPUT 

The^Domain ; Domain, 

Andjrhe_Range ; Ranges, 

In_The_Map : Map 
OUTPUT 

In_The_Map : Map 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Bindxng 

END 

OPERATOR Unbind 
SPECIFICATION 
INPUT 

The_Domain : Domain, 

In_The_Map : Map 
OUTPUT 

In_The_Map ; Map 
EXCEPTIONS 

Overflow, Domain„Is_Not_Boiind, Multiple_Binding 

END 

OPERATOR lS_Equal 
SPECIFICATION 
INPUT 

Left : Map, 

Right : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 


Overflow, Domain_Is_Not_Bo\md, Multiple_Binding 

END 

OPERATOR Extent^Of 

SPECIFICATION 

INPUT 

TheJMap : Map 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Is_Empty 

SPECIFICATION 

INPUT 

The_Map : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domain_Is^ot_Bound, Multipl€_Binding 

END 

OPERATOR Is^Boiind 

SPECIFICATION 

INPUT 

The_Doinain ; Domain, 

In_TheJMap ; Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Range_Of 

SPECIFICATION 

INPUT 

The_Domain : Domain, 

In_The_Map ; Map 
OUTPUT 

Result : Ranges 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Domain : in[t : Domain], The_Range 
in[t : Ranges], Continue : out[t : Boolean]] 

INPUT 

Over_TheJMap : Map 
EXCEPTIONS 

Overflow, Doniain_Is_Not_Bound, Multiple_Binding 

END 

END 

IMPLEMENTATION ADA 

Map_Siiiple_Noncached_Sequential_Unbounde<i_Managed^Iterator 

END 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Domain is private; 
type Ranges is private; 

Number_Of_Buckets : in Positive; 

with function Hash-Of {The_Doniain : in Domain) return Positive; 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 ;^ril 1995 

adding procedures to replace functions 

with procedure Hash_Of (The_Domain : in Domain; 

Result : out Positive); 

— end of medication 
paclcage 

Map_Simple_Noncached_Sequential_Unbounded_UnmanagedJ^oniterator is 

type Map is limited private; 

procedure Copy (FroirL_The_Map : in Map; 

To_Th€_Map ; in out Map); 

procedure Clear (The_Map : in out Map); 

procedure Bind (The_Domain ; in Domain; 

And_The_Range : in Ranges; 

In_The_Map : in out Map) ; 

procedure Unbind (The_Domain : in Domain; 

In_The_Map : in out Map); 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

adding procedures to replace functions 

procedure Is_Egual (Left : in Map; 


Right ; in Map; 

Result ; out Boolean); 
procedure Extent_Of (The_Map : in Map; 

Result : out Natural); 

procedure Is_Eitpty (TheJKap : in Map; 

Result : out Boolean); 
procedure Is_Bound (The_Doinain : in Domain; 

In_The_Map : in Map; 

Result : out Boolean); 

procedure Rcinge_^Of (The_Domain ; in Domain; 

ln_The_Map : in Map; 

Result : out Ranges); 

— end of modication 

fxanction Is_Equal (Left : in Map; 

Right : in Map) retxim Boolean; 

fvinction Extent_Of (TheJMap : in Map) return Natural; 
fxinction Is_Empty (The_Map : in Map) return Boolean; 
function Is^Bound {The_Domain : in Domain; 

In_The_Map : in Map) return Boolean; 
function Range_Of (The_Domain : in Domain; 

In_The_Map ; in Map) return Ranges; 

Overflow : exception; 

Domain_IsJMot_Bo^md : exception; 

Multiple^Binding : exception; 

private 

type Node; 

type Structure is access Node; 

type Map is array (Positive range 1 .. Number_Of_Buckets) of 
Structure; 

end Map_S imp le_NoncachedLSeguen t ial_Unbormde<LUninanaged^oni terator 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 
—of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

-- Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package body 

Map_Simple_Noncached_Sequential_Unbounded_Unmanaged_Noniterator rs 

type Node is 
record 

The_Doinain : Domain; 

The_Range : Reinges ; 

Next : Structure; 

end record; 


procedure Find (The_Doinain : in Domain; 

In_The_Map : in Map; 

The_Bucket : out Positive; 

Previous_Node : in out Structure; 

Current_Node ; in out Structure) is 

Temporary_Bucket : Positive := 

(Hash^Of (The^Domain) mod 

Number_Of_Buckets) + 1; 
begin 

The_Bucket := Temporary_Bucket; 

Current^ode := In_TheJlap (Teinporary_Bucket) ; 
while CurrentJMode l~ null loop 

if Current_Node.The_Domain = The_Domain then 
return; 

else 

Previous_Node : = Current_J^ode; 

Current_Node := Current_Node.Next; 
end if; 
end loop; 
end Find; 

procedure Copy (From_The_Map ; in Map; 

To_The_^p : in out Map) is 
Fronuindex ; Structure; 

To_Index ; Structure; 
begin 

for Index in FroituTheJMap * Range loop 
Fronuindex := FrorruThe_Map {Index); 
if FronuThe_Map(Index) = null then 
To_'Ihe_Map(index) ;* null; 

else 

To_The_Map(Index) := new Node* 

(The_Domain => 

From_Index, The_Domain, 

The_Range => 

From_Index. The_Range, 

Next => null); 

To_Index := To_TheJMap(Index); 

Fronuindex := FronuIndex.Next; 
while From_Index /= null loop 
To^Index. Next : = new Node ' 

(The_Domain => 

Fronuindex. The__Domain, 

The_Range => 

Fronuindex. The_Range, _ 

Next => null); 

To_Index := To_Index.Next; 

Fronuindex := From_Index.Next; 
end loop; 
end if; 
end loop; 
exception 

when Storage_Error ==> 
raise Overflow; 
end Copy; 

procedure Clear (The^Map : in out Map) is 
begin 

The_Map := Map*(others => null); 
end Clear; 


procedure Bind {The_Domain : in Domain; 

AndLThe_Range : in Ranges; 

In_The_Map : in out Map) is 

The_Bucket ; Positive; 

PreviousJNode : Structure; 

CurrentJNode : Structure; 
begin 

Find(The_Domain, In^TheJMap, The_Bucket, Previousjlode, 
Current Jlode); 

if Current JNode /= null then 
raise Multiple_Binding; 

else 

In_‘rhe_Map{The_Bucket) := new Node* 


{‘The^Domain => The_Domain, 
The^Range => And_The_Range, 
Next => 

In_The_Map(The_Bucket)); 
end if; 
exception 

when storage_Error -> 
raise Overflow; 
end Bind; 

procedure Unbind (The^Domain : in Domain; 

In^'The.Map : in out Map) is 
The_Bucket : Positive; 

PreviousJJode : Structure; 

Current_Node : Structure; 
begin 

Find(The_Domain, IruThe^Map, The_Bucket, PreviousJJode, 
Current_Node) ; 

if Previous^ode = null then 

In_The_Map (The_Bucket) := Current^Node.Next; 

else 

]Previous_Node.Next := CurrentJNode.Next; 
end if; 
exception 

when Constraint_Error => 

raise Domain.„IsJNot_Bound; 
end Unbind; 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

adding procedures to replace functions 

procedure Is_Egual (Left : in Map; 

Right : in Map; 

Result : out Boolean) is 

begin 

Result := Is_Egual(Left,Right); 
end Is_Equal; 

procedure Extent^Of (The^ap : in Map; 

Result : out Natural) is 

begin 

Result ;= Extent_Of(The_Map); 
end Extent_Of; 

procedure Is_En^ty (The_Map : in Map; 

Result : out Boolean) is 

begin 

Result Is_Enpty(The_Map}; 
end Is_Eii 5 Jty; 

procedure Is„Bound (The_Domain : in Domain; 

In_TheJMap : in Map; 

Result ; out Boolean) is 

begin 

Result : = Is_Bound {The_Domain, In_The_Map) ; 
end Is_Bound; 

procedure Range^Of (The_Domain : in Domain; 

In..The_Map ; in Map; 

Result ; out Ranges) is 

begin 

Result :« Range_Of (TheJDomain, In_The_Map) ; 
end Range_0f; 

— end of modification 

function Is_Equal (Left : in Map; 

Right : in Map) return Boolean is 
Left_Index : Structure; 

Right_Index : Structure; 

Left_Count : Natural; 

Right_Count : Natural; 
begin 

for Index in Left'Range loop 

if (Left(Index) = null) xor (Right(Index) = null) then 
return False; 

else 

Left^Index := Left(Index); 

Left_Count := 0; 

while Left_Index /= null loop 

Right_Index :* Right(Index); 
while Right_Index /= null loop 
if (Left_Index.The_Domain = 

Right^Index.The_Domain) then 
exit; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Left_Index.The_Reinge /= Right_Index.The_Range 

then 

return False; 

else 

Left_Index ;= Left_Index.Next; 

Left_Count := Left_Co\jnt + 1; 
end if; 
end loop; 


no 








Right_Index := Right(Index); 

Right_Count := 0; 

while Right^Index /« null loop 

Right_Index := Right_Index.Next; 
Right_Count := Right^Count + 1; 
end loop; 

if Left_Count I- Right^Count then 
return False; 
end if; 
end if; 
end loop; 
return True; 
exception 

when Constraint_Error => 
return False; 
end Is_Eq[ual; 

function Extent_Of {The_Map : in Map) return Natural is 
Count : Natural := 0; 

TeirporaryJMode : Structure; 
begin 

for Index in The^Map'Range loop 

Terrporary_Node ;= The_Map (Index) ; 
while Temporary_Node /= null loop 
Count := Count + 1; 

Teit 5 )orary_Node := Teii: 5 )orary_Node .Next ; 
end loop; 
end loop; 
return Count; 
end Extent_Of; 


function Is^Enpty (TheJMap : in Map) return Boolean is 
begin 

return {The_Map = Map*(others => null)); 
end Is_Errpty; 

fimction Is__Boiind {The_Doinain : in Domain; 

In_TheJMap : in Map) return Boolean is 
The_Bucke t : Positive; 

Previous_Node ; Structure; 

Current_Node ; Structure; 
begin 

Find(The_Domain, In_The_Map, The_Buclcet, Previous_Node, 
ChirrentJIode); 

return (Current^ode /= null) ; 
end Is^Bound; 

f\mction Range_Of (The_Domain : in Domain; 

In_The_Map : in Map) return Ranges is 
The__Bucket : Positive; 

PreviousJNode : Structure; 

Current_Node : Structure; 
begin 

Find{The_Domain, In_The_Map, The_Bucket, PreviousJ^ode, 
CurrentJMode); 

re turn Current_Node.The_Range; 
exception 

when Constraint_Error => 

raise Doinain_Is_No t_Bound; 
end Range_Of; 

end Map_Simple_Noncached_Seguent ial_Unbounded_Uninanaged_Noni terator 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 


PSDL 


TYPE Map_Siittple_Noncached^SeQcaential_UnboundecLUninanaged^oniterator 

SPECIFICATION 

GENERIC 

Domain : PRIVATE_TYPE, 

Ranges : PRIVATE_TyPE, . . 

Hash_Of : FUNCTION[The_Domain : Domain, RETURN : Positive], 
Hash_Of : PROCEDURE[The_Domain ; in[t : Domain], Result : out[t : 
Positive]] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

FronL,The_Map : Map, 

To_The^ap : Map 
OUTPUT 

To_The_Map : Map 
EXCEPTIONS 

Overflow, DomainalsJTot_Bound, Multiple_Binding 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Map : Map 
OUTPUT 

The_Map : Map 

EXCEPTIONS . 

Overflow, Domain_IsJJot_Bound, Multiple^Binding 

END 

OPERATOR Bind 
SPECIFICATION 
INPUT 

The_Doinain : Domain, 

AncLTh€_Range : Ranges, 

In_The^ap : Map 
OUTPUT 

In_The Jlap : Map 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Unbind 
SPECIFICATION 
INPUT 

The_Doinain : Domain, 

In^The_Map : Map 
OUTPUT 

In_TheJ!ap : Map 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : Map, 

Right : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple^Binding 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

TheJMap : Map 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Domain_IsJNot_Botind, Multiple_Binding 

END 

OPERATOR Is_Ei!ipty 

SPECIFICATION 

INPUT 

The_Map : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Is_Bound 

SPECIFICATION 

INPUT 

The_Domain : Domain, 

In_The_Map : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Domain_Is_Not_Botind, Multiple_Bindang 

END 

OPERATOR Range^Of 

SPECIFICATION 

INPUT 

TheJ3omain : Domain, 

In_The.Jlap : Map 
OUTPUT 

Result : Ranges 
EXCEPTIONS 

Overflow, Domain_IsJMot_Bound, Multiple_Binding 

END 

END 

IMPLEMENTATION ADA 

Map_Simple_Noncached_Sequential_Unbounded_Unmanaged_Noniterator 

END 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Domain is private; 
type Ranges is private; 

Nuinber_Of_Buckets ; in Positive; 

with function Hash_Of (The_Domain : in Domain) return Positive; 

— modifiecl by Tuan Nguyen and Vincent Hong 

— date: 8 ;^ril 1995 

adding procedures to replace functions 

with procedure Hash_Of (The_Domain : in Domain; 

Result : out Positive); 

— end of modication 

pac)cage Map_Siirple_NoncachecLSequential_Unbounded_Unmanaged_Iterator 

is 

type Map is limited private; 

procedure Copy (FroitL,TheJMap : in Map; 

To_TheJKap : in out Map); 

procedure Clear (Thejlap : in out Map); 

procedtire Bind (The_Domain : in Domain; 

And_The_Range : in Ranges; 

In_TheJMap : in out Map); 

procedure Unbind (The^Domain : in Domain; 

In^The^ap : in out Map) ; 

-- modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

— adding procedures to replace functions 

procedure Is^Equal (Left ; in Map; 

Right : in Map; 

Result : out Boolean); 
procedure Extent_Of (The_J«ap : in Map; 


Result : out Natural); 

procedure Is_Eirpty (The_Map : in Map; 

Result : out Boolean); 
procedure Is_Bound {The^Domain ; in Domain; 

In_The_Map : in Map; 

Result : out Boolean); 

procedure Range_Of (The_Domain : in Domain; 

In_The_Map : in Map; 

Result : out Ranges); 

— end of modication 

function Is^Equal {Left : in Map; 

Right : in Map) return Boolean; 

f\anction Extent^Of (The_Map : in Map) return Natural; 

function Is_Einpty {The^Map : in Map) return Boolean; 

function Is_Bound {The_Domain : in Domain; 

In_The_^p : in Map) return Boolean; 
function Range_Of (The_Domain : in Domain; 

In_The_Map ; in Map) return Ranges; 

generic 

with procedure Process (The^Domain : in Domain; 

The_Range : in Ranges; 

Continue : out Boolean); 

procedure Iterate (Over_The_Map : in Map); 

Overflow : exception; 

Domainals_Not_Bound : exception; 

Multiple_Binding : exception; 

private 

type Node; 

type Structure is access Node; 

type Map is array {Positive range 1 .. Nuinber_Of_Buc)cets) of 
Structure; 

end Map_SiiipleJNoncached_Sequential_Unbounded_Unmanaged_Iterator; 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

-Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Coirputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package body 

Map_Siinple^oncachedLSequential_Unbounded_Uninanaged_Iterator as 


type Node is 
record 

The_Domain : Domain; 
The^Range : Ranges; 
Next : Structure; 

end record; 


procedure Find {The_Domain : in Domain; 

In_The_Map : in Map; 

The_Bucket : out Positive; 

Previous^ode : in out Structure; 

Current_^ode : in out Structure) is 

Teir?>orary_Bucket : Positive : = 

(Hash_Of {The_Doniain) mod 


Number_Of_Buckets) + 1; 
begin 

The_Bucket := Temporary^Bucket; 

CurrentJWode := In_TheJlap(Teiiporary_Bucket) ; 
while Current_;Node /= null loop 

if Current^Node. The__Domain - The_Domain then 


return; 

else 

Previous_Node := Current_Node; 
Current_Node := Current_Node.Next; 
end if; 
end loop; 
end Find; 


procedure Copy (Froin_The_Map ; in Map; 

To_The_Map : in out Map) is 
FronL.Index ; Structure; 

To_Index : Structure; 
begin 

for Index in FronuThe_Map‘Range loop 
From_Index := From_The_Map (Index); 
if FroirL,The_Map{Index) = null then 
To_The_Jlap (Index) : = null ; 

else 

To_The_Map(Index) := new Node' 

(The_„Domain => 

From^Index.The^Domain, 

The_Range => 

From_lndex.The_Range, 

Next => null); 

To_Index := To_The_Map (Index) ; 

From_lndex := From_lndex.Next; 
while From_Index /= null loop 
To_lndex.Next := new Node' 

(The_Domain => 

From^lndex.The^Domain, 

The_Range => 

Fronulndex.The_Range, 

Next => null); 

To^Index := To_Index.Next; 

From_Index := From_Index.Next; 
end loop; 
end if; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear {The_JIap : in out Map) is 
begin 

The_Map := Map'(others => null); 
end Clear; 

procedure Bind {The_Domain : in Domain; 

An{l_The_Range : in Ranges; 

In_The_Map : in out Map) is 

The_Bucket ; Positive; 

PreviousJJode ; Structure; 

CurrentJ^ode : Structure; 
begin 

Find(The_Domain, In_The_Map, The_Bucket, Previous_Node, 
Current_Node); 

if CurrentJNode f- null then 
raise Multiple_Binding; 

else 

In_The_Map(The_Bucket) := new Node' 


(The_Domain => The_Domain, 
'rhe_Range => AncLTlie_Range, 
Next => 

In_The_Map(The_Bucket)); 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Bind; 

procedure Unbind (The_Domain : in Domain; 

In_The_Map ; in out Map) is 
The_Bucket : Positive; 

PreviousJlode : Structure; 

Current_Node : Structure; 
begin 

Find(The_Domain, In_The_Map, The_Bucket, Previous_Node, 
Current_^ode); 

if Previous^ode = null then 

In_The^ap (The^Bucket) := CurrentJNode .Next ; 

else 

Previous_Node.Next : = Current_Node .Next; 
end if; 
exception 

when Constraint_Error => 

raise Domain_IsJNot_Bound; 
end Unbind; 

— modified by Tuan Nguyen and Vincent Hong 

— date: 8 April 1995 

— adding procedures to replace functions 

procedure Is_Equal (Left : in Map; 

Right ; in Map; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is^Equal; 

procedure Extent_Of (TheJMap : in Map; 

Result ; out Natural) is 

begin 

Result := Extent^Of(TheJMap); 
end Extent_Of; 

procedure Is^En^Jty (The^Map : in Map; 

Result : out Boolean) is 

begin 

Result := Is_Eirpty(TheJMap) ; 
end Is_Empty; 

procedure Is^Bound (The_Domain : in Domain; 

In_The_Map : in Map; 

Result : out Boolean) is 

begin 

Result := Is_Bound(The_Domain,In_The_Map); 
end Is_Bound; 

procedure Range_Of {The_Doinain : in Domain ; 

In_The_Jlap : in Map; 

Result ; out Ranges) is 

begin 

Result := Range_Of (The_Domain, In_The_Map); 
end Range_Of; 

end of modification 

function Is_Equal (Left : in Map; 

Right : in Map) return Boolean is 
Le ft_Index : S true ture; 

Right_Index : Structure; 

Left_Count : Natural; 

Right_Count : Natural; 
begin 

for Index in Left'Range loop 

if (Left(Index) = null) xor (Right(Index) = null) then 
return False; 

else 

Left_Index := Left(Index); 

Left_Count 0; 

while Left^Index /= null loop 

Right_Index := Right(Index); 
while Right^Index I- null loop 
if (Left_Index.The_Domain = 

Right_Index.The_Domain) then 
exit; 

else 

Right_lndex ;= Right_Index.Next; 
end if; 
end loop; 

if Left_Index.The_Range /= Right_Index.The_Range 

then 

return False; 

else 

Left_Index := Left_Index,Next; 

Left_Co\int := Left^Count + 1; 
end if; 
end loop; 
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Right_Index := Right(Index); 

Right_Co'unt : = 0 ; 

while Right_Index /= null loop 

Right_Index := Right_Index * Next; 
Right_Count := Right_Count + 1; 
end loop; 

if Left_Count /= Right^Coxant then 
return False; 
end if; 
end if; 
end loop; 
return True; 
exception 

when Constraint_Error => 
return False; 
end Is^Egual; 

function Extent_Of (The_^ap : in Map) return Natural is 
Count : Natural := 0; 

Ten?>oraryJtJode ; Structure; 
begin 

for Index in The_Map'Range loop 

Teinporary_jaode : = The_Jlap (Index); 
while Temporary_JJode null loop 
Count := Count + 1; 

TenporeoY-fJode := Teitporary_Node.Next; 
end loop; 
end loop; 
return Count; 
end Extent_Of; 

function Is_Ertipty (The_Map : in Map) return Boolean is 
begin 

return (The_Map *= Map'(others => null)) ; 
end Is_Ernpty; 

function Is^Bound (The_Doinain : in Domain; 

In_TheJlap ; in Map) return Boolean is 
The_Bucket ; Positive; 

Previous_Node : Structure; 

CurrentJWode : Structure; 
begin 

Find(The_Domain, In^The^Jap, The^Bucket, Previous_Node, 
CurrentJNode); 

return {CurrentJJode /= null); 
end Is_Bound; 


function Range_Of (The^Domain : in Domain; 

In_The_Jlap : in Map) return Ranges is 
The_Bucket : Positive; 

Previous_Node : Structure; 

Current JJode : Structure; 
begin 

Find(The_Domain, In_The_Map, The_Bucket, Previous^Node, 
Current_Node) ; 

return CurrentJJode.The_Range; 
exception 

when Constraint_Error => 

raise Doinain_Is_Not_Bound; 
end Range_0f; 

procedure Iterate {Over_The_Map : in Map) is 
The_Bucket : Positive := Over_The_Map'Last; 

The_Node : Structure; 

Continue : Boolean; 

begin 

for The_Iterator in Over_ThejMap’Range loop 
if Over_The_Map(The_Iterator) /= null then 
The_.Bucket := The__Iterator; 

TheJJode : = Ove r_The.Jlap (The_I t era tor) ; 
exit; 
end if; 
end loop; 

while TheJJode /= null loop 

Process{TheJJode.The_Domain, TheJlode.The_Range, 

Continue); 

exit when not Continue; 

The_Node := TheJJode.Next; 
if The_Node = null then 

for The_Iterator in (The_Bucket +1) .. 
Over_The_Map*Last loop 

if Over_TheJMap{The_Iterator) /= null then 
The_Bucket ;= The_Iterator; 

TheJlode ;= Over_The_Map(The_Iterator); 
exit; 
end if; 
end loop; 
end if; 
end loop; 
end Iterate; 

end Map_Sirr 5 >le_NoncachedLSequential_Unbounded_Unmanaged_Iterator; 
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MAP SIMPLE NONCACHED SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 


PSDL 


TYPE Map_Siinple_Noncached_Sequential_Unbounded_Uninanaged_Iterator 

SPECIFICATION 

GENERIC 

Domain : PRIVATE_TYPE, 

Ranges : PRrVATE_TyPE, 

HashuOf : FUNCTION[The.Domain ; Domain, RETU^ : Positive], 
Hash_Of : PROCEDURE[The_Domain : injt : Domain], Result : out[t 
Positive]] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Jttap ; Map, 

To_The_Jlap : Map 
OUTPUT 

To_The_Map ; Map 

EXCEPTIONS . ^ o- 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Map ; Map 
OUTPUT 

The_JIap : Map 

EXCEPTIONS , . ^ 

Overflow, Domain_Is_Not^Bound, Multiple^Binding 

END 


OPERATOR Bind 
SPECIFICATION 
INPUT 

The_Domain : Domain, 
AncLThe_Range : Ranges, 
In_TheJ«ap ; Map 
OUTPUT 

In_The_Map : Map 
EXCEPTIONS 

Overflow, Domain_IsJJot_Bound, 

END 


Multiple_Binding 


OPERATOR Unbind 
SPECIFICATION 
INPUT 

The^Domain : Domain, 

In_The_Map : Map 
OUTPUT 

In_TheJlap : Map 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, 

END 


Multiple^Binding 


OPERATOR Is_Equal 
SPECIFICATION 
•INPUT 

Left ; Map, 

Right : Map 
OUTPUT 

Result : Boolean 
EXCEPTIONS 


Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Extent_Of 
SPECIFICATION 
I2«>UT 

The_Map : Map 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 

OPERATOR Is_Empty 
SPECIFICATION 
INPUT 

The_Map : Map 
OUTPUT 

Result ; Boolean 

EXCEPTIONS . , . 

Overflow, Domain_Is_Not_Botind, Multiple_Binding 

END 


OPERATOR IS_Bound 
SPECIFICATION 
INPUT 

The^Domain : Domain, 

In_TheJMap : Map 
OUTPUT 

Result : Boolean 

EXCEPTIONS . 

Overflow, Domain_Is_Not_Bound, Multiple_Binding 

END 


OPERATOR Range_Of 
SPECIFICATION 
INPUT 

The^Domain : Domain, 

In_The_Map : Map 
OUTPUT 

Result : Ranges 
EXCEPTIONS 

Overflow, Domain_Is_Not^Bound, 

END 


Multiple_Binding 


OPERATOR Iterate 
SPECIFICATION 

^'^P^cess : PROCEDURE[The^Domain ; in[t : Domain], The^Range : 
in[t : Ranges], Continue : out[t : Boolean]] 

INPUT 

Over_The_^p : Map 

EXCEPTIONS . ... 

Overflow, Domain.....ls_Not_Bound, Multiple_Binding 

END 


END 

IMPLEMENTATION ADA ^ 

Map_Siiiple_Nonc ached_Sequen t ia l_Unbouiide<l_Unmanaged_I ter a tor 
END~ 
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QUEUES 0BJ3 SPECIFICATION 


obj QUEUE[X :: TRIV] is sort Queue . 
protecting NAT . 
subsorts NzNat < Nat . 

*** constructors 

op create ; -> Queue . 

op copy : Queue Queue -> Queue . 

op clear : Queue -> Queue . 

op add : Elt Queue -> Queue . 

op pop : Queue -> Queue . 

op removeitem ; Queue NzNat -> Queue . 

*** accessors 

op isequal : Queue Queue -> Bool . 

op lengthof : Queue -> Nat . 

op isenpty : Queue -> Bool . 

op frontof : Queue -> Elt . 

op positionof : Elt Queue -> Nat . 

*** exceptions 

op overflow : -> Queue . 

op underflow ; -> Queue . 

op underflow : -> Elt . 

op positionerror : -> Nat . 

*** variables declarations 

var Q Q1 : Queue . 


var E El : Elt . 

var P : NzNat - 

*** axioms 

eq copy(Q,Ql) = Q . 

eq clear(Q) = create . 

eq pop(create) = underflow . 

eq pop(add{E,Q)) = if Q == create then create else add(E,pop(Q)) fi 


eq removeitem(create,P) * \mderflow . 

eq removeitem(add(E,Q),P) = if P == lengthof(Q) + 1 then Q else 
add(E,removeitem{Q,P)) fi . 

eq isequal(Q,Q1) = Q == Q1 . 

eg lengthof(Q) = if Q == create then 0 else 1 + lengthof(pop(Q)) fi 
eq iseirpty(Q) = Q == create . 
eq frontof(create) = underflow . 

eq frontof(add(E,Q)) = if q == create then E else frontof(Q) fi . 
eg positionof(E,create) = positionerror . 

eq positionof(E,add(El,Q)) = if E == El then lengthof(Q) + 1 else 
positionof(E,Q) fi . 

endo 
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QUEUES PROFILE CODES 


OPERATORS 

SIGNATURES 

PROFILE CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

ADD 

AB->B 

3211 

POP 

A-> A 

2201 

REMOVE_ITEM 

AB-> A 

3211 

IS_E0UAL 

AB->C 

330 

LENGTH_OF 

A->B 

220 

IS.EMPTY 

A->B 

220 

FRONT.OF 

A->B 

220 

POSmON.OF 

A->B 

220 


SET OF PROFILE: {3211,2201,330,220} 
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QUEUE NONPRIORITY BALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA SPECIFICATION 


generic 

type Item is private; 

package Queue„Nonpriority_Balking_Sequential_Bounded_Managed_Iterator 
is 


type Queue(The_Size : Positive) is limited private; 


procedure Copy 

procedure Clear 
procedure Add 

procedure Pop 
procedure Remove^Item 


(Fromjrhe^Queue 

in 


Queue; 

To_The_Queue 

in 

out 

Queue); 

(The_Queue 

in 

out 

Queue); 

(The_Item 

in 


Item; 

To_The_Queue 

in 

out 

Queue); 

(The__Queue 

in 

out 

Queue); 

{Froin_The_Queue 

in 

out 

Queue; 

At_The_Position 

in 


Positive); 


modified by Tuan Nguyen 
replacing functions with procedures 


procedure Is_Equal 


procedure 

procedure 

procedure 

procedure 


Length_Of 

Is^Enpty 

Front_Of 

Position^Of 


(Left 

Right 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Item 

InL.The_Queue 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 
out Natural); 
in Queue; 
out Boolean); 
in Queue; 
Item) ; 
in Item; 
in Queue; 


Result 


out Natural); 


end of modification 


function ls_Equal 

f-unction Length_Of 
function Is_Eirpty 
fxinction Front_Of 
fvine tion Position„Of 


(Left 

Right 

(The_Queue 

(The_Queue 

(The_Queue 

(The_Item 

In^The_Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 
in Item; 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
return Item; 

return Natural; 


generic 

with procedure Process (The„Item : in Item; 

Continue : out Boolean); 
procedure Iterate {Over_The_Queue : in C^ieue); 


Overflow : exception; 
Underflow : exception; 
Position_Error : exception; 


private 

type Items is array(Positive range <>) of Item; 
type Queue(The_Size : Positive) is 
record 

The_Back : Natural := 0; 

The_Items : Items(1 .. The_Size); 
end record; 

end QueueJNonpriority„Balking_Sequential_Bovinded^anagecLIterator; 


119 




QUEUE NONPRIORITY BALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 


ADA IMPLEMENTATION 


(C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 
All Rights Reserved 

Serial Number 0100219 


procedure Length^Of (The^Queue : in Queue; 

Result : out Natural) is 

begin 

Result := Length_0f(The_Queue); 
end Length_Of; 


“Restricted Rights Legend* 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Con?)Uter 

-- Software Clause of FAR 52.227-7013. Manufacturer; 

-- Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874) 


package body 

QueueJJonpriority_Balking_Sequential_BoundedLManaged_Iterator xs 

procedure Copy (FrotrL_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 

begin 

if FroirL.The_Queue.The_Back > To_The_Queue,The_Size then 
raise Overflow; 

elsif Frortt_The_Queue. The^Back = 0 then 
To_The_Queue.The_Back := 0; 

else 

To__The_Queue.The_Iterns(1 .. Froin_The_Queue.The_Back) : = 
From_.The_Queue. The_l terns (1 .. Fron\_The_Queue. The_Back) ; 
To_The_Queue.The^Back := From_The_Queue.The_Back; 
end if; 
end Copy; 

procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue*The_Back 0; 
end Clear; 


procedure Add (The^Item : in Item; 

To_The_Queue : in out Queue) is 

begin 

To_The_Queue. The_I terns (To_The_Queue.The_Back +1) ;= The_Item; 

To_The_Queue.The_Back := To_The_Queue.The_Back + 1; 
exception 

when Constraint_Error => 
raise Overflow; 

end Add; 

procedure Pop (The_Queue : in out Queue) is 
begin 

if The_Queue.The_Back = 0 then 
raise Underflow; 

elsif The_Queue.The_Back = 1 then 
The_Queue.The_Back := 0; 

else 

The_Queue. The_Iterns {1 . . (The_Queue. The_Back - 1)) : = 
The_Queue.The_Iterns(2 .. The_Queue.The_Back); 

The_Queue.The_Back ;= The_Queue.The_Back - 1; 
end if; 
end Pop; 

procedure Remove_Item (FronuThe^Queue : in out Queue; 

At_The_Position : in Positive) is 

begin 

if FroiiL_The_Queue. The_Back < At_The_Position then 
raise Position_Error; 

elsif From_The_Queue.The_Back /= At_The_Position then 
Fr oirL_The_Queue. The_I terns 

{At_The_Position .. (FroiiL.The_Queue,The_Back -1)) ; = 

FroiiL_The_Queue. The_l terns 

({At_The_Position +1) .. From_The_Queue.The_Back); 

end if; 

From_The_Queue.The_Back := From_The_Queue.The_Back - 1; 
end Remove^Item; 


procedure Is_Enpty (The_Queue 

Result 

begin 

Result : s: Is_Eiipty {The_Queue); 
end Is_Enpty; 

procedure Front^Of (The_Queue 

Result 

begin 

Result := Front_Of(The_Queue); 
end Front_Of; 


in Queue; 
out Boolean) is 


in Queue; 
Item) is 


procedure Position_Of 


(The_Item 

In_The_Queue 

Result 


in Item; 
in Queue; 
out Natural) 


begin 

Result := Position_Of(The_Item,In_The_Queue); 
end Position_Of; 


is 


end of modification 


function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 

begin 

if Left.The_Back /= Right.The_Back then 
return False; 

else 

for Index in 1 .. Left.The_Back loop 

if Left.The^Items(Index) /= Right.The_Iterns(Index) 


then 


end 


return False; 
end if; 
end loop; 
return True; 
end if; 

Is_Equal; 


fiinction Length_Of (The_Queue ; in Queue) return Natural is 
begin 

return The_Queue.The_Back; 
end Lengtlx_Of; 


function Is_Empty {The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Back = 0); 
end Is_Enipty; 


function Front^Of (The^Queue : in Queue) return Item is 
begin 

if The_Queue.The_Back = 0 then 
raise Underflow; 

else 

return The_Queue.The_Items(l); 
end if; 
end Front_Of; 


function Position_Of (The_Item ; in Item; 

In_The_Queue : in Queue) return Natural is 

begin 

for Index in 1 .. In_The_Queue.The„Back loop 

if In^The_Queue ,The_Iterns (Index) = The_Item then 
return Index,- 
end if; 
end loop; 
return 0; 
end Position_Of; 


modified by Tuan Nguyen 
replacing functions with procedures 


procedure Is_Egual (Left 
Right 
Result 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 


in Queue; 
in Queue; 
out Boolean) is 


procedure Iterate (Over_The_Queue : in Queue) is 
Continue ; Boolean; 
begin 

for The_Iterator in 1 . . Over_The_Queue. The_Back loop 

Process(Over_The_Queue.The_Items(The_Iterator), Continue); 
exit when not Continue; 
end loop; 
end Iterate; 

end Queue^onpriority_Balking_Sequential_Bounded_Managed_Iterator; 
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QUEUE NONPRIORITY BALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 


PSDL 


TYPE QueueJ^onpriority_Balking_Sequential_Bounde^Managed_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

Thfi-Queue : Queue 
OUTPUT 

■Hie—Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue ; Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow. Position_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The^Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

From_The_Queue : Queue, 

At_The_Position : Positive 
OUTPUT 

From_The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is^Equal 
SPECIFICATION 
INPUT 

Left : Queue, 

Right : Queue 


OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Eirpty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The__Queue : Queue 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Position^Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In_The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, position_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern ; in[t t Item], Continue : outEt 

Boolean]] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue^onpr ior i ty_Balking_Se<iuen t ial_BoundedJManaged_I terat or 

END 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

Queue_JJonprior i ty_Balking_Seo[uent ial_Un]Dounde^Manage(iJJoni terator rs 


type Queue is limited 

procedure Copy 

procedure Clear 
procedure Add 

procedure Pop 
procedure Remove_Item 


private; 

(FroirL_The_Queue : 
To_The_Queue : 
(The_Queue : 
{The_Item : 
To_'rhe_Queue : 
{The_Queue : 
{FroiiL.The_Queue : 
At_The_Position : 


in Queue; 
in out Queue); 
in out Queue); 
in Item; 
in out Queue); 
in out Queue); 
in out Queue; 
in Positive); 


Result : out Natural); 


end of modification 

function Is_Equal 

function Length^Of 
function Is^Einpty 
function Front_Of 
fimction Position_Of 


(Left : in 
Right : in 
(The_Queue : in 
(The^Queue : in 
(The_Queue : in 
(The_Item : in 
In_The_Queue : in 


Queue; 

Queue) return Boolean; 
Queue) return Natural; 
Queue) return Boolean; 
Queue) return Item; 
Item; 

Queue) return Natural; 


Overflow 

Underflow 

Position_Error 


exception; 

exception; 

exception; 


procedure Is_Equal 

procedure Length^Of 
procedure Is_Empty 
procedure Front_Of 
procedure Position_Of 


(Left 

Right 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Item 

In_The_Queue 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 
out Natural); 
in Queue; 
out Boolean); 
in Queue; 
Item); 
in I tern; 
in Queue; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front ; Structure; 

The_Back : Structure; 
end record; 

end 

Queue_Nonpriority_Balking_Seguential_Unbounded_JIanaged^oniterator; 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


-- (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nuiriber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is siAject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential; 
package body 

Queue_Nonpr ior i ty_Ba lking_Sequen t ial^UnboundedJManagedJJoni ter a t or 

is 


type Node is 
record 

The_Item : Item; 

Next : Structure; 
end record; 

procedure Free (The_Node : in out Node) is 
begin 

null; 
end Free; 

procedure Set_Next (The_Node ; in out Node; 

To_Next : in Structure) is 

begin 

The_^ode,Next To^Ne^ct; 
end SetJIext; 

function Next_Of {The_Node : in Node) return Structure is 
begin 

return The_^ode. Next ; 
end Next„Of; 

package NodeJManager is new Storage_Manager_Sequential 

(Item => Node, 

Pointer => Structure, 

Free => Free, 

Set^Pointer => SetJJext, 
Pointer_Of => Next_Of); 

procedure Copy (From_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
From_lndex : Structure := FrotrL.The_Queue. The_Front ; 
To_Index : Structure; 
begin 

Node_Manager.Free(To jrhe_Queue.The_Front); 

To_The_Queue.The^Back := null; 
if Fron\_The_Queue.The_Front /= null then 

To_The_Queue,The_Front := NodeJManager.New_Item; 

TojThe_Queue,The_Back ;= To_The_Queue.The^Front; 
TOj.The_Queue. The_Front. The_Itern : = From^Index. The_Item; 
TOjIndex := TOjThe_Queue. The_Front ; 

Fronulndex := From_Index.Next; 
while From_Index /= null loop 

TOjIndex.Next := NodeJManager.New_Itern; 
To_Index.Next.Thej.Item := From_Index.The_Item; 
TOjIndex := TOjIndex.Next; 

From_Index := FronuIndex.Next; 

To_The_Queue.The_Back ;= To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Queue : in out Queue) is 
begin 

Node_Manager.Free(The_Queue.The_Front); 

The_Queue.The_Back ;= null; 
end Clear; 


procedure Add (Thejitem : in Itern; 

To_The_Queue : in out Queue) is 

begin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front ;= Node_Manager.New_Item; 
To_The_Queue.The_Front.The_Item := The_Item; 
TOj.The_Queue.The_Back := To_The_Queue.The_Front; 

else 

To_The_Queue.The_Back.Next := NodeJManager.New_Itern; 
To_The_Queue. TheJBack. Next. The_I tern; = The_I tern ; 
ToZThe_Queue.The_Back := To_The_Queue.The_Back.Next; 
end if; 
exception 

when Storage_Error ss> 
raise Overflow; 

end Add; 


procedure Pop (The_Queue : in out Queue) is 
Tenporary_Node ; Structure; 


begin 

Teinporary_Node := The_Queue.The_Front; 

The^Queue. The^Front : - The^Queue. The_Front. Next ; 
Tenporary_Node, Next : == nul 1 ; 

NodeJManager. Free (TeitporaryjNode) ; 
if The_Queue.The_Front = null then 
The_Queue.The_Back := nu11; 
end if; 
exception 

when ConstraintjError => 
raise Underflow; 

end Pop; 

procedure Remove_Item (FronuThejQueue : in out Queue; 

Atj'IhejPosition : in Positive) is 

Count : Natural := 1; 

Previous : Structure; 

Index ; Structure ;= FronVjThe_Queue. The_Front ; 

begin 

while Index /- null loop 

if Count = At_The_Position then 
exit; 

else 

Count Count + 1; 

Previous Index; 

Index ;= Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position_Error; 
elsif Previous = null then 

From_The_Queue.The_Front ;= Index.Next; 

else 

Previous.Next ;= Index.Next; 
end if; 

if FroouThejQueue. TheJBack « Index then 
FronL.The_Queue. The_Back : = Previous; 
end if; 

Index.Next := null; 

NodeJManager,Free(Index); 
end Remove_Item; 

modified by Tuan Nguyen 
replacing functions with procedures 

procedure ISjEqual (Left : 

Right : 

Result : 

begin 

Result := ISjEqual(Left,Right); 
end ISjEqual; 

procedure LengthjOf (ThejQueue : 

Result : 

begin 

Result LengthjOf (The_Queue) ; 
end LengthjOf; 

procedure ISjEmpty {The_Queue : 

Result : 

begin 

Result := ISjEnpty(ThejQueue); 
end ISjErrpty; 

procedure Front_Of (The_Queue : 

Result : 

begin 

Result := FrontjOf(ThejQueue); 
end FrontjOf; 

procedure Position_Of (The_Item : 

In_ThejQueue : 

Result : 

begin 

Result := PositiottjOf(Thejitem,In_ThejQueue); 
end PositioUjOf; 

end of modification 

function ISjEqual (Left : in Queue; 

Right : in Queue) return Boolean is 
Leftjindex : Structure := Left.ThejFront; 

Rightjindex : Structure := Right.The_Front; 
begin 

while Leftjindex /= null loop 

if LeftjIndex.ThCjItem /= RightjIndex.ThejItem then 
return False; 

else 

Leftjindex := Left_Index,Next; 

Rightjindex := RightjIndex.Next; 
end if; 
end loop; 

return (Right_lndex = null); 
exception 

when ConstraintjError => 
return False; 
end ISjEgual; 

function Length_Of (The_Queue : in Queue) return Natural is 


in Queue; 
in Queue; 
out Boolean) is 


in Queue; 
out Natural) is 


in Queue; 
out Boolean) is 


in Queue; 
Item) is 


in I tern; 
in Queue; 
out Natural) is 
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Count ; Natural := 0; 

Index : Structure The_Queue.The_Front; 
begin 

while Index /= null loop 
Count := Cotmt + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Length^Of; 

function Is_Eti:pty (The_Queue ; in Queue) return Boolean is 
begin 

return {The_Queue.The_Front = null); 
end Is_Entpty; 

fimction Front^Of (The_Queue : in Queue) return Item is 
begin 

re turn The_Queue-The_Front.The_Itern; 
exception 

when Constraint_Error => 
raise Underflow; 


end Front_0f; 

fvinction Position_Of (The^Item : in Item; 

In_The_Queue : in Queue) return Natural is 
Position : Natural := 1; 

Index : Structure := IrL_The_Queue.The_Front; 
begin 

while Index /= null loop 

if Index.The_Itern s The_Item then 
return Position; 

else 

Position Position + 1; 

Index := Index.Next; 
end if; 
end loop; 
return 0; 
end Position_Of; 

end 

Queue^onpriority_Balking_SequentialJJnbounded_ManagecLNoniterator; 
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QUEUE NONPRIORITY BALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

PSDL 


TYPE 

Queue JJonpriori ty__Ba lking_Seqaent i al_UnboiindecfLManaged_Noni t era t or 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuThe_Queue ; Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The^Item : Item, 

To_Tlie_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Qu€ue : Queue 
OUTPUT 

The^Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

FronuThe^Queue : Queue, 

At_The_Position : Positive 
OUTPUT 

From_The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 


OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The^Queue : Queue 
OUTPUT 

Result 2 Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Empty 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result 2 Booleam 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The^Queue : Queue 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Position_Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In_The_Queue : Queue 
OUTPUT 

Result 2 Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue_Nonpriority_Balking_Sequential_Unbounded_^anage<3LNoniterator 

END 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

QueueJJonpriority_Nonbalking_Sequential_BoiindedJlanaged_Iterator rs 

type Queue(The_Size : Positive) is limited private; 

procedure Copy {From_The_Queue : in Queue; 

To_The_Queue ; in out Queue); 
procedure Clear (The_Queue : in out Queue); 

procedure Add {The_Item : in Item; 

To_The_Queue : in out Queue); 
procedure Pop {The_Queue : in out Queue); 

-- modified by Tuan Nguyen 
— replacing functions with procedures 

procedure Is_Equal (Left : in Queue; 

Right : in Queue; 

Result : out Boolean); 

procedure Length_Of {The_Queue : in Queue; 

Result : out Natural); 

procedure Is_Errpty (The_Queue : in Queue; 

Result : out Boolean); 

procedure Front_Of (The_Queue : in Queue; 

Result : Item); 


— end of modification 

function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean; 

f\mction Length_Of (The_Queue : in Queue) return Natural; 

function Is„Enpty (The_Queue : in Queue) return Boolean; 

function Front_Of (The_Queue ; in Queue) return Item; 

generic 

with procedure Process (The^Item : in I tern; 

Continue : out Boolean); 
procedure Iterate (Over_The_Queue : in Queue); 

Overflow : exception; 

Underflow : exception; 

private 

type Items is array (Positive range <>) of Item; 
type Queue(The_Si 2 e : Positive) is 
record 

The_Back : Natural := 0; 

The^Items : Items(1 .. The_Size); 
end record; 

end Queue^Nonpriority_Nonbalking_Sequential_Bounded_Managed„Iterator 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA IMPLEMENTATION 


(C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 
All Rights Reserved 

Serial Number 0100219 

"Restricted Rights Legend" 

Use. duplication, or disclosure is subject to 
restrictions as set forth in subdivision (b) (3) (ii) 
of the rights in Technical Data and Coitputer 
Software Clause of FAR 52.227-7013. Manufacturer: 
Wizard software, 2171 S. Parfet Court, Lakewood, 
Colorado 80227 (1-303-987-1874) 


end Is^Equal; 

procedure Length_Of (The_Queue : in Queue; 

Result ; out Natural) is 

begin 

Result Length^Of(The_Queue); 
end Length^Of; 

procedure Is_Enpty {The_Queue ; in Queue; 

Result : out Boolean) is 

begin 

ResuIt := is^Empty(The_Queue); 
end Is_Errpty; 


package body 

Queue_Nonpriority_Nonbalking_Sec3uential_Boiinded^Jlanaged_Iterator 

is 


procedure Copy (Froin_The_Queue : in Queue ; 

To_The_Queue : in out Queue) is 

begin 

if FroiiL_The_Queue.The_Back > To_The_Queue.The_Size then 
raise Overflow; 

elsif FrottL,The_Queue .The_Back = 0 then 
To_The_Queue.The_Back := 0; 

else 

To_The_Queue. The_I terns (1 .. FrortL_The_Queue. The_Back) : = 

FroiruThe^Queue. The_I terns (1 .. FrortL.The_Queue. The_Back) ; 
To_The_Queue. The_Back : = FronL.The_Queue. The_Back ; 
end if; 
end Copy; 

procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue.The_Back := 0; 
end Clear; 

procedure Add (The_Item : in Item; 

To_The_Queue : in out Queue) is 

begin 

To_The_Queue .The_Iterns (To_The_Queue.The_Back +1) := The_Item; 

To_The_Queue. The_>Back ;= To_The_Queue. The_Back + 1; 
exception 

when Constraint_Error => 
raise Overflow; 

end Add; 

procedure Pop (The_Queue ; in out Queue) is 
begin 

if The_Queue.The_Back = 0 then 
raise Underflow; 

elsif The_Queue.The_Back = 1 then 
The_Queue.The_Back := 0; 

else 

The_Queue.The_Items{1 .. (The_Queue.The_Back -1)) : = 

The_Queue. The_Iterns (2 . . The_Queue. The_Back) ,- 
The_Queue.The_Back := The_Queue.The_Back - 1; 
end if; 
end Pop; 

modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_Equal (Left 
Right 
Result 

begin 

Result := Is_Equal(Left,Right); 


: in Queue; 

; in Queue; 

: out Boolean) is 


procedure Front_0f (The_Queue ; in Queue; 

Result : Item) is 

begin 

Result := Front_0f(The_Queue); 
end Front_Of; 

end of modification 


function Is_E< 3 ual (Left : in Queue; 

Right : in Queue) return Boolean is 

begin 

if Left.The_Back /= Right-The^Back then 
return False; 

else 

for Index in 1 .. Left.The_Back loop 

if Left.The_Items(Index) /= Right.The_Iterns(Index) 


then 


return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 


function Length_Of (The_Queue : in Queue) return Natural is 
begin 

return The_Queue.The_Back; 
end Length^Of; 

function Is_Enpty (The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Back = 0); 
end Is_En?5ty; 


£^lnction Front_Of (The_Queue : in Queue) return Item is 
begin 

if The_Queue.The_Back = 0 then 
raise Underflow; 

else 

return The_Queue.The_Items(l) ; 
end if; 
end Front_Of; 


procedure Iterate (Over_The_Queue : in Queue) is 
Continue : Boolean; 
begin 

for The^Iterator in 1 .. Over_The^Queue.The^Back loop 

Process(Over_The_Queue.The_Iterns(The^Iterator), Continue); 
exit when not Continue; 
end loop; 
end Iterate; 


end QueueJJonpriority_Nonbalking_Sequential^BoundedJlanaged^I terator ,- 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 


PSDL 


TYPE Oueue_Nonpriority_JJonbalking_Sequential_Bounded_Managed_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroiiL_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The^Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is„Equal 
SPECIFICATION 
INPUT 

Left : Queue, 

Right : Queue 


OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length^Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is^Enpty 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front^Of 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The.Itern : in[t : Item], Continue ; outIt 

Boolean!] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue^onpriority_Nonbalking_Seguential_Bounded_Managed_Iterator 

END 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

Queue_Honpr ior i ty_Nonbalking_S€quen t ial_Unbounded_Manageti_Noni t era t or 
is 


type Queue is limited private; 

procedure Copy (Fron\_The_Queue ; in Queue; 

To_The_Queue : in out Queue); 

procedure Clear (The_Queue ; in out Queue); 

procedure Add (The^Item : in Item; 

To_The_Queue : in out Queue); 

procedure Pop (The_Queue : in out <^eue); 

modified by Tuan Nguyen 
replacing functions with procedures 

: in Queue; 

: in Queue; 

; out Boolean); 
: in Queue; 

: out Natural); 
: in Queue; 

: out Boolean) ; 


procedure Is_Equal 


procedure Length_Of 
procedure Is_Enpty 


(Left 

Right 

Result 

(The_Queue 

Result 

(The^Queue 

Result 


procedure Front_Of (The_Queue 
Result 


end of modification 


in Queue; 
Item) ; 


function Is^Ecjual (Left 
Right 

f\mction Length_Of (The_Queue 
function Is_Enpty (The_Queue 
ftinetion Front_Of (The_Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
return Item; 


Overflow : exception; 
Underflow : exception; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : Structure; 
end record; 

end 

Queue^Nonpr ior i tyJ^onba lking_Sequent i a l_UnboundedL_ManagedLNoni t er a t or 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grac3y Booch 

— All Rights Reserved 


when Storage_Error »> 
raise Overflow; 

end Add; 


— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) {3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential ; 
package body 

Queue_Nonpriority_Nonbalking_Seguential_UnboundedJIanaged_Noniterator 

is 


type Node is 
record 

The_Item ; Item; 

Next : Structure; 
end record; 

procedure Free (The_Node : in out Node) is 
begin 

null; 
end Free; 

procedure Set_Next {The_Node : in out Node; 

To_„Next : in Structure) is 

begin 

TheJfode. Next : = To_Next ,- 
end Set_Next; 

function Next_Of {The_Node : in Node) return Structure is 
begin 

return The^Node.Next; 
end Next_0f; 

package Node_Nanager is new Storage_Manager_Sequential 

(Item => Node, 

Pointer => Structure, 

Free => Free, 

Set_Pointer => Set_Next, 

Pointer_Of Next_Of); 


procedure Pop (The__Queue : in out Queue) is 
TenporaryJNode : Structure; 
begin 

TemporaryJNode : = The_Queue. The^Front; 

The_Queue.The_Front := The_Queue.The_Front•Next; 
Temporary^Node.Next := null; 

Node_Manager. Free (Tenporary_Node); 
if The_Queue,The_Front = null then 
The_Queue.The_Back ;= null; 
end if; 
exception 

when Constraint^Error => 
raise Underflow; 

end Pop; 

modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_Equal (Left 
Right 
Result 

begin 

Result := Is^Equal(Left,Right); 
end Is_Egual; 

procedure Length_0f (The_Queue 
Result 

begin 

Result := Length_Of(The_Queue); 
end Length_Of; 

procedure Is_Enpty (The_Queue 

Result 

begin 

Result ;= Is^Eirpty (The_Queue) ; 
end Is_Eirpty; 

procedure Front_Of (The_Queue 

Result 

begin 

Result := Front_Of(The_Queue); 
end Front^Of; 

end of modification 


: in Queue; 

: in Queue; 

: out Boolean) is 


: in Queue; 

: out Natural) is 


: in Queue; 

: out Boolean) is 


: in Queue; 
: Item) is 


procedure Copy (From_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
From_Index : Structure := FroiiuThe_Queue.The_Front; 
To_Index : Structure; 
begin 

Node_Manager.Free(To_The_Queue.The_Front); 

To_The_Queue. The^Back : == null; 
if From_The_Queue.The_Front /= null then 

To_The_Queue.The_Front := NodeJIanager.New_Item; 
To_The_Queue.The_Back := To_The_Queue,The_„Front; 
To^The^Queue. The_Front. The_I tem ; = From_Index. The_Itern; 
To_Index := To_The_Queue.The_Front; 

From_Index ; = From_Index. Next; 
while Froin_Index /= null loop 

To_Index. Next : = Node^Manager. New_I t em ; 

To__Index. Next. The_l tem : = Fror\_Index. The_I tem ; 
To_Index := To_Index.Next; 

Froni_Index := From^Index.Next; 

To_The_Queue. The_Back := To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Queue : in out Queue) is 
begin 

Node_^anager. Free (The_Queue. The__Front); 

The__Queue. The_Back : = null ; 
end Clear; 

procedure Add (The^Item : in Item; 

To_The_Queue : in out Queue) is 

begin 

if To_The_Queue. The_Front = null then 

To_The_Queue. The_Front := Node_Manager.New_Item; 
To_The_Queue .The_Front .The_Item := The_Item; 
To_The_Queue.The_Back ;= To_The_Queue.The_Front; 

else 

To_The_Queue.The_Back.Next ;= Node_Manager,New_Item; 
To_The_Queue. The_Back. Next. The_I tem: = The_l tem ; 
To_The_Queue. The_Back : = To_The_Queue. The_Bac k. Next ; 
end if; 
exception 


function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 
Left_Index : Structure := Left.The_Front; 

Right_Index : Structure := Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index.The_Item Right_Index.The_Item then 
return False; 

else 

Lef t_Index := Left_Index.Next; 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length_Of (The_Queue : in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure ;= The_Queue.The_Front; 
begin 

while Index /- null loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Length_Of; 

function Is_Eir?>ty (The_Queue ; in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = null); 
end Is_Eir 5 >ty; 

function Front_Of (The_Queue : in Queue) return Item is 
begin 

return The_Queue. The_Front. The_I tem; 
exception 

when Constraint_Error => 
raise Underflow; 
end Front_Of; 

end 

Queue_Nonpr ior i tyJJonbalking_Seguen t i al_UnboundedJManagedLNoni t er at or 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

PSDL 


TYPE 

Queue JMonpr ior i ty J^onbal king_Sequen t i a l_Unbo'unded_ManagedjNoni tera tor 
SPECIFICATION 

GENERIC 

Item : PRIVATE_TYPE 

OPERATOR Copy 

SPECIFICATION 

INPUT 

Froii:L_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 

SPECIFICATION 

INPUT 

Th,e_Queue : Queue 
OUTPUT 

Th,e_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 

SPECIFICATION 

INPUT 

The_Item : Item, 

To_The_Queue ; Queue 
OUTPUT 

To_The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 

SPECIFICATION 

INPUT 

The^Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 


OPERATOR Is.Egual 

SPECIFICATION 

INPUT 

Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The^Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_En^ty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue^^Jonpr i or i tyJNonbalking_Sequen t xal_Unbounded_Managed_Noni t er a tor 
END 


131 



QUEUE PRIORITY BALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 


ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function PrioritY_Of (The_Item : in Item) return 

Priority; 

with function "<=" {Left ; in Priority; 

Right : in Priority) return Boole^; 
package Queue_Priority_Balking_Sequential_Bounded^ManagedLIterator is 


type Queue{The_Size : Positive) is limited private; 


procedure Copy 

procedure Clear 
procedure Add 

procedure Pop 
procedure Remove_Item 


(FronuThe^Queue 
To_The_Queue 
(The_Queue 
(The_Item 
To_The_Queue 
(The_Queue 
{From_The_Queue 
At_The_Position 


in Queue; 
in out Queue); 
in out Queue); 
in Item; 
in out Queue); 
in out Queue); 
in out Queue; 
in Positive); 


— modified by Tuan Nguyen 

replacing functions with procedures 


procedure Position_Of 


(The_Item 

In_The_Queue 

Result 


in Item; 
in Queue; 
out Natural); 


end of modification 


function Is_Egual 


function Length_Of 
function Is_Enpty 
function Front_Of 
function Position_Of {The_Item 

In_The„Queue 


(Left 

Right 

(The_Queue 

(The^Queue 

(The_Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 
in Item; 
in Queue) 


return Boolean 
return Natural 
return Boolean 
return Item; 

return Natural 


generic 

with procedure Process (The_Item : in Itern; 

Continue : out Boolean); 
procedure Iterate (Over_The_Queue ; in Queue); 


Overflow : exception; 
Underflow ; exception; 
Position_Error : exception; 


procedure Is^Equal 


procedure Length^Of 
procedure Is^Errpty 
procedure Front^Of 


(Left 

Right 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Queue 

Result 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 
out Natural); 
in Queue; 
out Boolean); 
in Queue; 
Item) ; 


private 

type Items is array (Positive range <>) of Item; 
type Queue(The_Size : Positive) is 
record 

The_Back : Natural := 0; 

The_Iterns : Items(1 .. The_Size); 
end record; 

end Queue_Priority_Balking_Sequential_Bounded^anaged_Iterator; 
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QUEUE PRIORITY BALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in s\ibdivision (b) (3) (ii) 

— of the rights in Technical Data and Conqputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body 

Queue_Priority_Balking_Sequential_Bounded_Mcinaged_Iterator is 

procedure Copy (FronuThe^Queue ; in Queue; 

To_The_Queue : in out Queue) is 

begin 

if FronuThe_Queue.The_Back > To_The_Queue.The_Size then 
raise Overflow; 

elsif FroitL.The_Queue. The_Back = 0 then 
To_The_Queue.The_Back ;= 0; 

else 

To_The_Queue.The^Iterns(1 .. FrotrL.The_Queue.The_Back) : = 
FrortL_The_,Queue. The_l terns (1 .. FronuThe_Queue. The_Back); 
To_The_Queue. The_Back : = FrottuThe^Queue. The_Back ; 
end if; 
end Copy; 

procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue. The_Back :== 0; 
end Clear; 

procedure Add (The_Item : in Item; 

To_The_Queue ; in out Queue) is 
Index : Natural := 1; 
begin 

if To_The_Queue.The_Back = 0 then 

To_The_Queue. The_I terns (To_The_Queue. The_Bac k + 1) : = 

The_Item; 

To_The_Queue.The_Back := To_The_Queue.The_Back + 1; 

else 

while (Index <= To_The_Queue.The^Back) and then 
(Priority„Of(The_Itern) <= 

Priority_0f (To_The_Queue .The_Items (Index))) loop 
Index := Index + 1; 
end loop; 

if Index > To_The_Queue.The_Back then 

To_The_Queue. The_I terns (To_The_Queue.The_Back + 1) : = 

The_Item; 

To_The_Queue. The_Back := To_The_Queue. The_Back + 1; 

else 

To_The_Queue. The_I terns 

((Index +1) .. (To_The_Queue.The_Back +1)) : = 

To_The_Queue.The_Iterns(Index .. 
To_The_Queue.The_Back); 

To_The_Queue. The_I terns (Index) : = The_I t em ; 
To_The_Queue,The_Back := To_The_Queue.The_Back + 1; 
end if; 
end if; 
exception 

when Constraint_Error => 
raise Overflow; 

end Add; 

procedure Pop (The_Queue : in out Queue) is 
begin 

if The_Queue.The^Back = 0 then 
raise Underflow; 

elsif The_Queue.The_Back = 1 then 
The_Queue.The_Back ;= 0; 

else 

The_Queue.The_Iterns(1 .. (The_Queue.The_Back - 1)) : = 
The_Queue-The_Items (2 The_Queue.The_Back) 

The_Queue.The_Back := The_Queue.The^Back - 1; 
end if; 
end Pop; 

procedure Remove_ltem {Fronv„The_Queue : in out Queue; 

At_The_Position ; in Positive) is 

begin 

if FroirL.The_Queue. The_Back < At_The_Position then 
raise Position_Error; 

elsif Front_The_Queue.The^Back /= At_The_Position then 
From_The_Queue.The^Items 

(AtJIhe^Position .. (From_The_Queue.The_Back -1)) : = 
From_The_Queue.The_Iterns 

((At_The_Position +1) .. FroitL.The_Queue.The_Back); 

end if; 

From_The_Queue. The_Back := FronuThe_Queue. The_Back - 1; 
end Remove_Item; 


— modified by Tuan Nguyen 

— replacing fxmctions with procedures 

procedure Is_E( 3 ual (Left : in Queue; 

Right : in Queue; 

Result : out Boolean) is 

begin 

Result := Is_Egual(Left,Right); 
end Is_Egual; 

procedure Length_Of (The_Queue : in Queue; 

Result : out Natural) is 

begin 

Resu11 := Leng th_0 f(The_Queue); 
end Length_0f; 

procedure Is_En?>ty (The^Queue : in Queue; 

Result : out Boolean) is 

begin 

Result := Is_Empty{The_Queue); 
end Is_Enpty; 

procedure Front_0f (The_Queue : in Queue; 

Result : Item) is 

begin 

Result := Front_0f(The_Queue); 
end Front_Of; 

procedure Position_0f (The_Item : in Item; 

In_The_Queue : in Queue; 

Result : out Natural) is 

begin 

Result := Position_0f {The_Item, In_The_Queue) ; 
end Position_0f; 

— end of modification 


function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 

begin 

if Left.The_Back /= Right.The_Back then 
return False; 

else 

for Index in 1 .. Left.The_Back loop 

if Left .The_I terns (Index) /- Right .The_I terns (Index) 


return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 


fimction Length_Of (The_Queue ; in Queue) return Natural is 
begin 

return The_Queue.The_Back; 
end Length^Of; 


function Is^Enpty (The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.Th€_Back = 0); 
end Is_Enipty; 


function Front_0f (The_Queue : in Queue) return Item is 
begin 

if The_Queue.The_Back «= 0 then 
raise Underflow; 

else 

return The^Queue.The_Iterns(1); 
end if; 


end Front_Of; 


function Position_Of {The_Item ; in Item; 

In_The_Queue : in Queue) return Natural is 

begin 

for Index in 1 .. In_The_Queue. The_Back loop 

if ln_The_Queue.The_Iterns (Index) = The_Item then 
return Index; 
end if; 
end loop; 
return 0; 
end Position_Of; 


procedure Iterate (Over_The_Queue ; in Queue) is 
Continue ; Boolean; 
begin 

for The_Iterator in 1 .. Over_The_Queue. The_Back loop 

Process (Over_The_Queue.The^Items (The_Iterator), Continue) ; 
exit when not Continue; 
end loop; 
end Iterate; 


end Queue_Priority_Balking_Sequential_Bounded_ManagecLlterator ; 
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QUEUE PRIORITY BALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 


PSDL 


TYPE Queue_Priority_Balking_Sequential_Bo\inded_MaiiagecLIterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

Priority ; PRIVATEJTYPE, 

Priority_Of : FUNCTION[The_Itern : Item, RETURN : Priority], 
fuiic_"<=" : FUNCTION[Left : Priority, Right : Priority, RETURN : 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

Fron\_The_Queue ; Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The^Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

Fron\_,The_Q^eus ■ Queue, 

At_The_Position : Positive 
OUTPUT 

FronL.The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : Queue, 

Right : Queue 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

end 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Ernpty 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front^Of 

SPECIFICATION 

INPUT 

The^Queue ; Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position„Error 

END 

OPERATOR Position^Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In^The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Item : in[t : Item], Continue 

Boolean]3 
INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue_Priority_Balking_Sequential_Bounded_Jlanaged_Iterator 

END 


OUt[t : 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function Priority_Of (The_Item : in Item) return 

Priority; 

with function "<=" {Left : in Priority; 

Right : in Priority) return Boolean; 

package 

Queue_Priority_Balking_Se<3uential_Unbounded_ManagedJ^oniterator is 


type Queue is limited private; 


procedure Copy 

procedure Clear 
procedure Add 

procedure Pop 
procedure Remove_Item 


(From_The_Queue 
To_'I1ie_Queue 
(The^Queue 
(The_Item 
To_The_Queue 
(The_Queue 
(From_The_Queue 
At_The_Position 


in 


Queue; 

in 

out 

Queue); 

in 

out 

Queue); 

in 


I tern; 

in 

out 

Queue); 

in 

out 

Queue); 

in 

out 

Queue; 

in 


Positive) 


Result 

procedure Front_,Of (The_Queue 
Result 

procedure Position_Of (The^Item 

In_The_Queue 

Result 


out Boolean); 
in Queue; 
Item); 
in Item; 
in Queue; 
out Natural); 


end of modification 


function Is_Equal 

function Length_Of 
function Is_Ernpty 
function Front_Of 
function Position_Of 


(Left 

in 

Queue; 



Right 

in 

Queue) 

return 

Boolean; 

(The^Queue 

in 

Queue) 

return Natural; 

(The_Queue 

in 

Queue) 

return 

Boolean; 

(The_Queue 

in 

Queue) 

return 

Item; 

(The_Item 

in 

Item; 



In_The__Queue 

in 

Queue) 

return Natural; 


Overflow 

Underflow 

Position_Error 


exception; 

exception; 

exception; 


— modified by Tuan Nguyen 

replacing functions with procedures 


procedure Is_Equal 

procedure Length_Of 
procedure Is_Enpty 


(Left 
Right 
Result 
(The_Queue 
Result 
(The_Queue 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 
out Natural); 
in Queue; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : S t rue ture; 
end record; 

end Queue_Priority_Balking_Sequential_UnboundedLManagedJHoniterator; 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 
--All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

-- Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential; 
package bo^ 

Queue_Priority_Balking_Sequential_Unbounded_Managed_Noniterator is 

type Node is 
record 

The^Item : Item; 

Next : Structure; 

end record; 

procedure Free {The_Node : in out Node) is 
begin 

null; 
end Free; 

procedure Set_Next (The_Node : in out Node; 

To_Ne3Ct : in Structure) is 

begin 

The_Node.Next := ToJNext; 
end Set^ext; 

function Next_Of (The_Node ; in Node) return Structure is 
begin 

return The^ode.Next; 
end Next_Of; 

package Node_J!anager is new Storage_Manager_Sequential 

(Item => Node, 

Pointer => Structure, 

Free => Free, 

Set_Pointer => Set_Next, 
Pointer_Of => Next_Of); 

procedure Copy (From_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
From_Index : Structure := FronuThe^Queue.The_Front; 
To_lndex : Structure; 
begin 

NodeJManager. Free {To_The_Queue, The_Front); 

To_The_Queue.The_Back := null; 
if From_The_Queue.The_Front null then 

To_The_Queue.The_Front := Node JManager.New_Itern; 
To__The_Queue. The^Back : = To_The_Queue. The_Front ; 
To_The_Queue. The_Front. The_l tern : = Pronuindex. The_l tern; 
To_Index := To_The_Queue.The_Front; 

From^lndex := From_Index.Next; 
while From_Index /= null loop 

To_Index.Next := Node_Manager.New_Item; 
To_Index.Next-The_Item := FronuIndex.The^Item; 
To_Index := To_Index.Next; 

Fronjindex := From_lndex.Next; 

To_The_Queue . 'llxe_Back : = To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


To_The_Queue.The_Front.Next := Index; 
if To_The_Queue.The_Back = null then 

To_The_Queue. Ihe^ack : = To_The_Queue. The_Front ; 
end if; 

elsif Index = null then 

To_The_Queue,The_Back.Next := Node_Manager.New_Itern; 
To_The_Queue.The_Back := To_The_Queue.The_Back.Next; 
To_The_Queue.The_Back.The_Item := The^Item; 

else 

Previous.Next := Node_Manager.New_Iteni; 

Previous.Next.The_Item := The_Item; 

Previous.Next.Next := Index; 
end if; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Pop (The_Queue ; in out Queue) is 
Teiitporary_Node ; Structure; 
begin 

Temporary_Node :» The_Queue. The_Front; 

The_Queue.The_Front := The_Queue.The_Front.Next; 

Temporary^Node.Next z- null; 

Node^Manager,Free(Tenporary_Node); 
if The_Queue,The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

procedure Remove_Item (Froin_The_Queue : in out Queue; 

At_The_Position : in Positive) is 
Count : Natural := 1; 

Previous : Structure; 

Index : Structure ;= From_The_Queue.The_Front; 
begin 

while Index /= null loop 

if Count = At_The_Position then 
exit; 

else 

Count := Count + 1; 

Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position_Error; 
elsif Previous = null then 

From_The_Queue.The_Front := Index.Next; 

else 

Previous.Next := Index.Next; 
end if; 

if Froit\_'Ihe_Queue.The_Back = Index then 
From_The_Queue.The_Back := Previous; 
end if; 

Index.Next := null; 

Node_Manager.Free(Index); 
end Remove_Item; 

modified by Tuan Nguyen 
replacing fxinctions with procedures 

procedure Is„Equal (Left ; in Queue; 

Right ; in Queue; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 


procedure Clear ('Ihe_Queue : in out Queue) is 
begin 

Node_Manager.Free(The_Queue.The_Front); 
The_Queue.Th€_Back := nu11; 
end Clear; 


procedure Length^Of (The_Queue : in Queue; 

Result : out Natural) is 

begin 

Result := Length_Of(The_Queue); 
end Length_0f; 


procedure Add (The_Item : in I tern; 

To_The_Queue : in out Queue) is 
Previous : Structure; 

Index : Structure := To_The_Queue.The_Front; 
begin 

if To_The_Queue.The_Front = null then 

To^The_Queue. The_Front := Node_Manager .New_Item; 
To_The_Queue.The_Front.The_Item := The__Item; 
To_The_Queue.The_Back := To_The_Queue.The_Front; 

else 

while (Index /= null) and then 
(Priority_0f(The_ltern) <= 

Priority_Of(Index,The_Itern)) loop 
Previous := Index; 

Index Index,Next; 
end loop; 

if Previous = null then 

To__The__Queue. The_Front : = Node_Manager. Newi,! tem; 
To_The__Queue - The_Front. The_Item : = The_I tern; 


procedure Is_Eitpty (The_Queue 

Result 

begin 

Result := Is_Empty(The_Queue); 
end Is_En 5 )ty; 

procedure Front_Of (The_Queue 

Result 

begin 

Result := Front^Of(The_Queue); 
end Front_Of; 


in Queue; 
out Boolecin) is 


in Queue; 
Item) is 


procedure Position_Of 


{The_Item 

In_The_Queue 

Result 


in Item; 
in Queue; 
out Natural) 


begin 

Result := Position_Of(The_Item,In_The_Queue); 
end Position_Of; 


is 


136 







end of modification 

function Is^Equal (Left : in Queue; 

Right : in Queue) return Boolean is 
Left^Index : Structure := Left.The^Front; 

Right_Index : Structure Right.The_Front; 

begin 

while Left_Index /= null loop 

if Left_lndex-The_ltem /= Right_Index.The_Item then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_Index := Right^Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

fxinction Length_Of (The_Queue : in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure := The_Queue.The_Front; 
begin 

while Index /= null loop 
Coiint := Count + 1; 

Index := Index.Next; 
end loop; 
return Coxmt; 
end Length^Of; 


function Is_Enpty {The_Queue : in Queue) return Boolean is 
begin 

return {The_Queue.The_Front = null); 
end Is_En?>ty; 

function Front_Of (The_Queue : in Queue) return Item is 
begin 

return The_Queue. The_Front. The_Itern ; 
exception 

when Constraint_Error => 
raise Underflow; 
end Front_Of; 

function Position_Of (The_Item : in Item; 

In^The_Queue : in Queue) return Natural is 
Position : Natural := 1; 

Index : Structure In_The_Queue.The_Front; 
begin 

while Index /= null loop 

if Index.The„Itern = The_Item then 
return Position; 

else 

Position := Position + 1; 

Index ;= Index.Next; 
end if; 
end loop; 
return 0; 
end Position_0f; 

end Queue_Pr ior i ty_Balking_Sequential_UnboundedLJlanagedJMoni terator; 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Queue^Priori ty_Balking_Sequential_Unbounded_Managed_Noni t erator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

Priority : PRIVATE_TYPE, 

Priority_Of : FUNCTION[The_Itern ; Item, RETURN ; Priority], 
func_“<=" : FUNCTION[Left : Priority, Right : Priority, RETURN ; 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

Froii\_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

From_The_Queue : Queue, 

At_The_Position : Positive 
OUTPUT 

Prom_The_Queue ; Queue 
EXCEPTIONS 


Overflow, Underflow, Position^Error 

END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left ; Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The^Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Enpty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front^Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Position^Of 

SPECIFICATION 

INPUT 

The^ltem : Item, 

In_The_Queue ; Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue_Priority__Balking_Sequential_Unbounded_JlanagedJNoniterator 

END 
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QUEUE PRIORITY NONBALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with fxinction Priority_Of {The_Item : in Item) return 
Priority; 

with function "<=" (Left : in Priority; 

Right : in Priority) return Boolean; 
package Queue_Priority_Nonbalking_Sequential_Bo\indecLJlanagecLIterator 
is 


type Queue(The_Size ; Positive) is limited private; 



Result 

: out Boolean) 

procedure Front_0f 

(The^Queue 

: in Queue; 

end of modification 

Result 

: Item); 


£;mction Is^Egual (Left 
Right 

function Length_Of (The^Queue 
function Is_E[npty (The_Queue 
function Front_Of {The_Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
ret\im Item; 


procedure Copy (From_The_Queue ; in Queue; 

To_The_Queue : in out Queue); 
procedure Clear (The^Queue : in out Queue); 

procedure Add (The_Item : in I tern; 

To_The_Queue : in out Queue); 
procedure Pop (The_Queue : in out Queue); 

— modified by Tuan Nguyen 

— replacing functions with procedures 


procedure Is_Equal 


procedure Length_Of 
procedure Is_Enpty 


(Left 

Right 

Result 

(The_Queue 

Result 

(The_Queue 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 
out Natural); 
in Queue; 


generic 

with procedure Process (The^Item : in Item; 

Continue : out Boolean); 
procedure Iterate (Over_The_Queue : in Queue); 

Overflow : exception; 

Underflow ; exception; 

private 

type Items is array(Positive range <>) of Item; 
type Queue(The^Size : Positive) is 
record 

The_Back : Natural ;= 0; 

The_ltems : Items(1 .. The_Size); 
end record; 

end Queue_PriorityJNonbalking_Seguential_Bounded_ManagedLIterator; 
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QUEUE PRIORITY NONBALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C> Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nximber 0100219 

-Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) {3) (ii) 

— of the rights in Technical Data and Coitputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874) 

package body 

Queue_Priority_JJonbalking_Sequential_BoundedJIanagedLIterator is 

procedure Copy (Fron\_The_Queue : in Queue; 

To_The_Queue ; in out Queue) is 

begin 

if FrorcL.The_Queue. The_Back > To_The_Queue. The^Size then 
raise Overflow; 

elsif FroitL.The_Queue. The_Back = 0 then 
To_The_Queue.The_Back := 0; 

else 

To_The_Queue.The„Iterns(1 .. FronuThe_Queue.The_Back) := 
FrortuThe_Queue. The_I tems (1 .. FroiR_The_Queue. The_B ack) ; 
To_The_Queue. The_Back : = FronuThe_Queue. The_Back ; 
end if; 
end Copy; 

procedure Clear (The_Queue : in out Queue) is 
begin 

The__Queue. The_B ack : = 0; 
end Clear; 

procedure Add (The^Item : in Item; 

To_The_Queue : in out Queue) is 
Index : Natural 1; 
begin 

if To_The_Queue.The_Back = 0 then 

To_The_Queue. The_I terns (To_The_Queue. The^Back + 1) : = 

The_Item; 

To_The_Queue.The_Back := To_The_Queue.The_Back + 1; 

else 

while (Index <= To_The_Queue.The_Back) and then 
(Priority_Of(The_Item) <= 

Priority_Of{To_The_Queue.The_Iterns{Index))) loop 
Index := Index + 1; 
end loop; 

if Index > To_The_Queue.The_Back then 

To_The_Queue. The_I terns {To_The_Queue-The_Back +1) : = 

The_Itein; 

To_The_Queue.The_Back ;= To_The_Queue.The_Back + 1; 

else 

To_The_Queue. The_I terns 

((Index +1) .. (To_The_Queue.The_Back +1)) := 

To_The_Queue.The_Iterns(Index .. 

To_The_Queue. The_Back) ; 

To_The_Queue. The_I terns {Index) ; = The_I tem ; 
To_The_Queue.The_Back := To_The_Queue.The_Back + 1; 
end if; 
end if; 
exception 

when Constraint_Error => 
raise Overflow; 

end Add; 

procedure Pop (The_Queue : in out Queue) is 
begin 

if The_Queue.The_Back = 0 then 
raise Underflow; 

elsif The__Queue.The_Back = 1 then 
The_Queue.The_Back 0; 

else 

The_Queue.The_Items(l .. (The_Queue.The_Back - D) : = 
The_Queue. The_I terns (2 . . The_Queue. The_Back) ; 
The_Queue.The_Back := The_Queue.The__Back - 1; 
end if; 


end Pop; 


modified by Tuan Nguyen 
replacing functions with procedures 


procedure Is_Equal (Left 
Right 
Result 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 


in Queue; 
in Queue; 
out Boolean) is 


procedure Length_Of (The_Queue : in Queue; 

Result : out Natural) is 

begin 

Result Length_Of(The_Queue); 
end Length^Of; 

procedure Is^Empty {The_Queue : in Queue; 

Result : out Boolean) is 

begin 

Result := Is„En 5 pty(The_Queue) ; 
end Is_Errpty; 


procedure Front_Of (The_Queue : in Queue; 

Result : Item) is 

begin 

Result := Front_Of(The^Queue); 
end Front_Of; 


end of modification 


function Is^Equal (Left : in Queue; 

Right : in Queue) return Boolean is 

begin 

if Left.The_Back /= Right.The_Back then 
return False; 

else 

for Index in 1 .. Left.The_Back loop 

if Left.The_Items(Index) /= Right.The_Iterns(Index) 


end if; 
end loop; 
return True; 
end if; 
end Is^Equal; 

function Length_Of (The_Queue : in Queue) return Natural is 
begin 

re turn The_Queue.The_Back; 
end Length_Of; 

fijnction Is^Empty (The_Queue ; in Queue) return Boolean is 
begin 

return (The_Queue.The_Back = 0); 
end Is_En^ty; 


function Front_Of (The_Queue ; in Queue) return Item is 
begin 

if The_Queue.The_Back = 0 then 
raise Underflow; 

else 

return The^Queue. The_Iterns (1) ; 
end if; 
end Front_Of; 


procedure Iterate (Over_The_Queue ; in Queue) is 
Continue : Boolean; 
begin 

for The^Iterator in 1 .. Over_The_Queue.The^Back loop 

Process(Over_The_Queue.The_Iterns(The_Iterator), Continue 
exit when not Continue; 
end loop; 
end Iterate; 


end Queue_Priority_Nonbalking_Sequential_Bounded_Managed_Iterator; 
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QUEUE PRIORITY NONBALKING SEQUENTIAL BOUNDED MANAGED ITERATOR 

PSDL 


TYPE Queue_Priority_JMonbalking_Sequential_BoundedJManaged_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

Priority : PRIVATE_TYPE, 

Priority_Of : FUNCTION[The_Itern : Item, RETURN : Priority], 
func_*'<=“ ; FUNCTION[Left : Priority, Right : Priority, RETURN : 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuThe_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is Eir 5 >ty 

SPECIFICATION 

INPUT 

The^Queue ; Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue ; Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : in[t : Item], Continue : out(t 
Booleain] ] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue_Pr i or i tyJNonba Iking^Sequen t ial_BoundecLManaged_I ter a t or 
END 
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QUEUE PRIORITY NONBALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function Priority_Of {The_Item : in Item) return 

Priority; 

with function “<=- (Left : in Priority; 

Right : in Priority) return Boolean; 

package 

Queue^Priority_Nonbalking_Sequential_Unbounded_JIanaged_Noniterator xs 
type Queue is limited private; 


Result 

procedure Front_Of (The_Queue 
Result 


end of modification 


out Boolean); 
in Queue; 
Item) ; 


function Is_Equal (Left 
Right 

function Length_Of (The_Queue 
function Is_Err 5 >ty (The_Queue 
f\inction Front_Of {The_Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
return Itern; 


procedure Copy 

procedure Clear 
procedure Add 

procedure Pop 


(FroirL_The_Queue 
To„The_Queue 
{The_Queue 
(The_Item 
To_The_Queue 
(The_Queue 


in Queue; 

in out Queue); 
in out Queue); 
in I tern; 

in out Queue); 
in out Queue); 


modified by Tuan Nguyen 
replacing functions with procedures 


procedure Is_Equal (Left 

Right 
Result 

procedure Length_Of (The_Queue 
Result 

procedure Is_Eit 5 )ty (The_Queue 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 
out Natural); 
in Queue; 


Overflow : exception; 

Underflow ; exception; 

private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The^Front : Structure; 

The_Back : Structured- 
end record; 

end 

Queue_Priority^onbalking_Sequential_Unbounded_Managed__Noniterator 
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QUEUE PRIORITY NONBALKING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential; 
package body 

Queue_Pr ior i ty_Nonbalking_Sequen t i a l_Unbounded_Managed_Noni t er a t or 
is 

type Node is 
record 

The_Itein : I tern; 

Next : Structure; 

end record; 

procedure Free (ThejNode : in out Node) is 
begin 

null; 
end Free; 

procedure Set^Next (ThejNode : in out Node; 

To_Next : in Structure) is 

begin 

The_Node. Next : = To_JJext; 
end Set_Next; 

function Next^Of (The_Node : in Node) return Structure is 
begin 

return The_Node.Next; 
end Next_Of; 

package Node_Manager is new StorageJ4anager_Sequential 

(Item => Node, 

Pointer => Structure, 

Free => Free, 

Set_Pointer => Set_Next, 
Pointer_Of => Next_Of); 

procedure Copy (FronuThe^Queue : in Queue; 

To^The^Queue : in out Queue) is 
Fronjlndex : Structure := From_The_Queue.The^Front; 
To_Index ; Structure; 
begin 

Node_llanager. Free (To_The_Queue. The_Front); 

To_The_Queue.The_Back := null; 
if From_The_Queue.The_Front /= null then 

To_The_Queue. The_Front ; = NodeJMtenager, New_I tern ; 
To_The_Queue. The_Back : = To__The_Queue. The_Front; 
To_The_Queue.The_Front.The_Itern := From^Index.The_Item ; 
To^Index := To_The_Queue.The_Front; 

Prom^Index := From_Index,Next; 
while From_Index /= null loop 

To_Index. Next : = Node_^anager. New_I tern ; 

To^Index. Next. The_I tem : = Fron\_Index. The_I tern; 
To^Index := To_Index.Next; 

From_Index := From_Index.Next; 

To_The_Queue.The_Back To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Queue ; in out Queue) is 
begin 

NodeJlanager. Free {The_Queue. The_Front); 

'Kae_Queue.The„Back := null; 
end Clear; 

procedure Add (The^Item : in I tern; 

To_The_Queue : in out Queue) is 
Previous : Structure; 

Index : Structure := To_The_Queue. The_Front; 
begin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front := Node_Manager.New_Itern; 
To_The_Queue.The_Front.The_Item := The_Item; 
To_The_Queue. The_Back : = To__The_Queue. The_Front ; 

else 

while (Index /= null) and then 
{Priority_Of{The_Item) <= 

Priority_Of(Index.The_Itern)) loop 
Previous := Index; 

Index ;= Index.Next; 
end loop; 

if Previous = null then 

To_'I1ie_Queue. The_Front : = Node_Manager .New_Item; 


To_The„Queue.The_Front.The_Itern := The^Item; 
To_The_Queue. The_Front. Next : s: index ; 
if To_The_Queue.The_Back = null then 

To_The_Queue.The_Back r = Tojrhe_Queue.The_Front ; 
end if; 

elsif Index = null then 

To__The_Queue.The_Back.Next Node_Manager.New_Item; 
To_The_Queue.The_Back := To_The_Queue.The_Back.Next; 
To_The_Queue.The_Back.The_Item := The_Item; 

else 

Previous.Next : = NodeJManager.New_Itern; 

Previous.Next.The_Item :*= The_Item; 

Previous.Next.Next := Index; 
end if; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Pop (The_Queue : in out Queue) is 
Temporary JNode ; Structure; 
begin 

Tenporary__Node := The_Queue. The_Front; 

The_Queue.The_Front := The_Queue.The_Front.Next; 
Tert^porary_Node.Next ;= null; 

Node__Manager. Free (Teinporary__Node) ; 
if The_Queue.The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

— modified by Tuan Nguyen 

— replacing functions with procedures 

procedure Is_E<iual (Left : in Queue; 

Right : in Queue; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Length_Of {The_Queue : in Queue; 

Result : out Natural) is 

begin 

Result Length_Of(The_Queue); 

end Length_Of; 

procedure Is_Empty (The_Queue : in Queue; 

Result : out Boolean) is 

begin 

Result Is_Enipty(The_Queue) ; 

end Is_En?>ty; 

procedure Front_Of (The_Queue : in Queue; 

Result : Item) is 

begin 

Result := Front_Of(The_Queue); 
end Front_0f; 

end of modification 

function Is_Ec 3 ual (Left : in Queue; 

Right ; in Queue) return Boolean is 
Left_Index : Structure ;= Left.The_Front; 

Right_Index ; Structure := Right.The_Front; 
l3egin 

while Left_Index /= null loop 

if Left_Index.The_Item /= Right_Index.The_Item then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end ls_Egual; 

function Length_0f (The_Queue ; in Queue) return Natural is 
Count : Natural := 0; 

Index ; Structure := ThejQueue.The_Front; 
begin 

while Index /= null loop 
Count := Coxint + 1; 

Index := Index.Next; 
end loop; 
return Coxint; 
end Length_Of; 

function Is_Enipty (The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = null); 
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end Is_Eii?5ty; 


function Front_Of (The_Queue ; in Queue) return Item is 
begin 

return The_Queue-The_Front.The_Itern; 
exception 


when Constraint_Error => 
raise Underflow; 
end Front_Of; 


end 

Queue_Pr ior i ty_Nonbalking_Sequen t ial_UnboundedUManaged_Noni t era tor 
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QUEUE PRIORITYNONBALHNG SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

PSDL 


TYPE 

Queue_Pr ior i ty^onba lking_Se< 3 uent i a l_Unboundec5Lflanaged_Noni t er a t or 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE, 

Priority : PRIVATE_TYPE, 

Priority_Of : FUNCTION[The_Item ; Item, RETURN : Priority!, 
func_"<=“ : FUNCTION[Left : Priority, Right : Priority, RETURN ; 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

Fro]H_The_Queue : Queue, 

To_The_Queue ; Queue 
OUTPUT 

To_The__Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The^Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The^Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The^Queue : Queue 
OUTPtJT 

The_Queue : Queue 
EXCEPTIONS 


Overflow, Underflow 

END 

OPERATOR Is„Equal 

SPECIFICATION 

INPUT 

Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length_Of 

SPECIFICATION 

iNPtrr 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is^Empty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front.Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue_PriorityJMonbalking„Sequential_Unboundec3LManage<3LNoniterator 

END 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 


ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

Queue^Nonpriority_Balking_Sequential_tJnbounded_Uninanaged_Iterator is 
type Queue is limited private; 


procedure Copy 

{FronuThe^Queue 

: in 

Queue; 

To_The_Queue 

: in out 

Queue); 

procedure Clear 

(The_Queue 

: in out 

Queue); 

procedure Add 

(The_Item 

: in 

Item; 

To^The^Queue 

: in out 

Queue); 

procedure Pop 

(The_Queue 

; in out 

Queue); 

procedure Remove_Item 

(From_The_Queue 

: in out 

Queue; 

At_The_Positxon : in 

Positive 

modified hy Tuan Nguyen 
replacing functions with procedures 



procedure Is_E<iual 

(Left : 

in Queue; 



Right : 

in Queue; 



Result ; 

out Boolean); 

procedure Length_Of 

{The_Queue : 

in Queue; 


Result : 

out Natural); 

procedure Is_Empty 

(The_Queue : 

in Queue; 


Result : 

out Boolean); 

procedure Front^Of 

(The^Queue ; 

in Queue; 


Result ; 

Item); 


procedure Position_Of 

(The_Item ; 

in Itern; 


In_The_Queue : 

in Queue; 



Result : out Natural); 


end of modification 


function Is_Equal 

function Length_Of 
function Is_Eirpty 
function FrontjOf 
function Position_Of 


(Left 
Right 
(The_.Queue 
{The_Queue 
{The^Queue 
(The_Item 
In_The_Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 
in Item; 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
return Item; 

return Natural; 


generic 

with procedure Process (The_Item : in Item; 

Continue : out Boolean); 
procedure Iterate (Over_The_Queue : in Queue); 


Overflow ; exception; 
Underflow ; exception; 
Position^Error ; exception; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back ; Structure; 
end record; 

end Queue_Nonpriority_Balking_Sequential_UnboundedLUnmanaged_Iterator; 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Niimber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in stibdivision (b) (3) (ii) 

— of the rights in Technical Data and CoiT?)uter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874} 

package body 

Queue_Nonpr iori ty_Balking_Sequent ial_Unbounded_Unmcinaged_I terator 
is 


type Node is 
record 

The_Item : Item; 

Next : Structure; 

end record; 


procedure Copy {Froin_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
From_Index : Structure := FronuThe_Queue.The_Front; 
To_Index : Structure; 
begin 

if FronL_The_Queue.The_Front = null then 
To_The_Queue.The_Front := null; 

To_The_Queue.The_Back := null; 

else 


To_The_Queue. The^Front : = 

new Node' (The_Item => Frorrulndex.The^Item, 
Next => null); 

To_The_Queue.The_Back ;= To_The_Queue.The_Front; 
To_Index := To_The_Queue.The_Front; 

Frortuindex ;= Frort^Index.Next; 
while Fron\_Index /= null loop 

To_Index.Next := new Node'{The_Itern => 
From_Index. The_Item, 


Next => null); 


To_Index := To_Index.Next; 
Fronuindex := Froin^Index.Next; 
To_The_Queue.The_Back := To_Index; 
end loop; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 
end Copy; 


Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position_Error; 
elsif Previous = null then 

From_The_Queue.The_Front ;= Index.Next; 

else 

Previous.Next ;= Index.Next; 
end if; 

if FronuThe„Queue.The_Back = Index then 
From_The_Queue.The_Back := Previous; 
end if; 

end Remove^Item; 

modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is^Egual (Left : 

Right : 

Result : 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Length_Of (The^Queue : 

Result ; 

begin 

Result ;= Length_Of(The_Queue); 
end Length_Of; 

procedure Is_Empty (The_Queue : 

Result : 

begin 

Result := Is_En55ty (The_(Jueue) ; 
end Is_Empty; 

procedure Front_Of (The_Queue : 

Result : 

begin 

Result :» Pront_0f(The_Queue); 
end Front_0f; 

procedure Position„0f (The_Item : 

In„The_Queue : 

Result : 

begin 

Result := Position_Of(The_Item,In_The_Queue); 
end Position_Of; 

end of modification 


in Queue; 
in Queue; 
out Boolean) is 


in Queue; 

out Natural) is 


in Queue; 

out Boolean) is 


in Queue; 
Item) is 


in I tern; 
in Queue; 
out Natural) is 


procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue := Queue *(The_Front => null, 
The_Back => null); 

end Clear; 


procedure Add (The^Item : in Item; 

To_The_Queue ; in out Queue) is 

begin 

if To_The_Queue.The^Front = null then 

To_The_Queue.The_Front ;= new Node' (The^Item => The_Item, 

Next => null); 

To_The_Queue.The_Back := To_The_Queue.The_Front; 

else 


To_The_Queue.Th€_Back.Next := new Node'(The„Itern => 


The_Item, 


To_The_Queue.The_Back 
end if; 
exception 

when Storage_Error => 
raise Overflow; 


Next => null); 
To_The_Queue. The^Back. Next; 


end Add; 


procedure Pop (The_Queue : in out Queue) is 
begin 

The_Queue.The_Front := The_Queue.The_Front.Next; 
if The_Queue.The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when Constraint^Error => 
raise Underflow; 

end Pop; 


function Is_Equal (Left ; in Queue; 

Right : in Queue) return Boolean is 
Left_Index : Structure := Left.The_Front; 

Right_Index : Structure := Right.The_Front; 
begin 

while Left^Index /= null loop 

if Left_Index.The_Item /= Right_Index.The_Item then 
return False; 

else 

Left_Index Left_Index.Next; 

Right_Index :s Right^Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is„Equal; 

function Length^Of (The_Queue : in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure := The_Queue.The_Front; 
begin 

while Index /= null loop 
Count ;= Count + 1; 

Index ;= Index.Next; 
end loop; 
return Count; 
end Length^Of; 

function Is_Enpty {The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = nu11); 
end Is_En?)ty; 


procedure Remove_Item (From_The_(5ueue : in out Queue; 

At_The_Position : in Positive) is 
Count : Natural := 1; 

Previous : Structure; 

Index : Structure := Fronu.The_Queue.The_Front; 

begin 

while Index /= null loop 

if Colont = At_The_Position then 
exit; 

else 

Coiont ;= Count + 1; 


function Front„Of (The^Queue : in Queue) return Item is 
begin 

re turn The^Queue.The_Front.The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Front_Of; 

function Position^Of (The_Item ; in Item; 

In^The_Queue : in Queue) return Natural is 
Position ; Natural ;= 1; 
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Index : Structure := In_The_Queue,The_Front; 
begin 

while Index /= null loop 

if Index.The_Itern = The_ltem then 
return Position; 

else 

Position := Position + 1; 

Index := Index.Next; 
end if; 
end loop; 
return 0; 
end Position_Of; 


procedure Iterate (Over_The_Queue : in Queue) is 

The_Iterator : Structure := Over_The_Queue.The_Front; 

Continue : Boolean; 

begin 

while not (The_Iterator = null) loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end Queue_Nonpr i ori ty_Balking_Sequent ial_UnboundedLUninanagedLI terat or; 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

PSDL 


TYPE Queue_Nonpriority_^alking_Sequential_Unbo'undled_Uninanaged^Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Froiti_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue ; Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The^Queue : Queue 
OUTPUT 

The^Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

FronuThe^Queue : Queue, 

At_The_Position ; Positive 
OUTPUT 

Froiru.The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Egual 
SPECIFICATION 
INPUT 

Left : Queue, 

Right ; Queue 


OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Length^Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Etnpty 

SPECIFICATION 

INPUT 

The^Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front^Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Position_Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In_The_Queue : Queue 
OUTPirr 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position__Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : in[t : Item], Continue ; out[t 
Boolean]] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue_Nonpr ior i ty_Balking_Se(3uen t ial_Unbounded_Unmanaged_I t era t or 
END 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Unmanaged_Iterator 
is 


type Queue is limited private; 


procedure Copy (From_The__Queue : in Queue; 

To_The_Queue : in out Queue); 
procedure Clear (The_Queue : in out Queue); 

procedure Add (The^ltem : in Item; 

To_The_Queue : in out Queue); 
procedure Pop (The_Queue : in out Queue); 

modified by Tuan Nguyen 
replacing ftmctions with procedures 


procedure Is_Equal 


procedure 

procedure 

procedure 


Length_Of 

Is_Empty 

Front^Of 


(Left 

Right 

Result 

{The_Queue 

Result 

(The_Queue 

Result 

(The^Queue 

Result 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 
out Natural); 
in Queue; 
out Boolean); 
in Queue; 
Item) ; 


end of modification 


fiinction Is_Equal (Left 
Right 

fimction Length_Of (The_Queue 
function Is_Errpty {The_Queue 
function Front_Of (The^Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
return Itern; 


generic 

with procedure Process (The^Item : in Item; 

Continue : out Boolean); 
procedure Iterate {Over_The_Queue : in Queue); 


Overflow : exception; 
Underflow : exception; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The^Back ; Structure; 
end record; 

end 

Queue_Nonpr ior i ty_Nonba lking_Seciuent i al_Unbounded_Unmanaged_I t era tor 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

-- "Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision {b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body 

Queue_Nonpr ior i ty_Nonbalking_Seguent ial_UnboundecLUnmanagecLI t er at or 
is 


type Node is 
record 

The_Item : Item; 

Next : Structure; 
end record; 

procedure Copy {From_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
Fronuindex : Structure := FroitL_The_Queue. The_Front ; 
To_Index : Structure; 
begin 

if FrorrL_The_Queue.The_Front = null then 
To_'The_Queue.The^Front := null; 

To„The_Queue.The_Back := nul1; 

else 

To_The_Queue.The^Front := 

new Node’{The_Item => From_Index.The_rtem, 

Next => null); 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
To_Index := To_The_Queue.The_Front; 

From_Index := From_Index.Next; 
while From_Index /= null loop 

To_Index.Next := new Node' (The_Item => 
Fronuindex, The_I tern. 

Next => null); 

To^Index := To_Index. Next; 

Fronuindex := Frortuindex .Next ; 

To_The_Queue.The_Back := To^Index; 
end loop; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 
end Copy; 


procedure Clear {The_Queue : in out Queue) is 
begin 

The_Queue := Queue *(The^Front => null, 
The_Back => null); 

end Clear; 


procedure Add (The_Item : in Item; 

To_The_Queue ; in out Queue) is 

begin 

if To_The_Queue.The^Front = null then 

To_The_Queue. The_Front ;= new Node ’ {The_Itern => The_Item, 

Next => null); 

To_The_Queue. The_Back : = To_The_Queue. The„Front; 

else 

To_The_Queue.The_Back.Next new Node' (The_Item => 


The_Item, 


Next => null); 


To_The_Queue. The^Back : = To_The_Queue. The_Back. Next; 
end if; 


exception 

when Storage_Error => 
raise Overflow; 


end Add; 


procedure Pop (The_Queue : in out Queue) is 
begin 

The^Queue.The_Front := The_Queue.The_Front.Next; 
if The_Queue-The_Front = null then 
The__Queue.The_Back := null; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 


— modified by Tuan Nguyen 

— replacing f\mctions with procedures 

procedure Is_Equal (Left : in Queue; 

Right : in Queue; 

Result ; out Boolean) is 

begin 

Result ; = Is_Equal (Left, Right) ,* 
end Is_Equal; 

procedure Length_0f (The_Queue ; in Queue; 

Result : out Natural) is 

begin 

Result := Length_Of(The_Queue); 
end Length_0f; 

procedure Is_Enpty (The_Queue : in Queue; 

Result : out Boolean) is 

begin 

Result := Is_Enpty {The_Queue) ; 
end Is_EiBpty; 

procedure Front_0f (The_Queue : in Queue; 

Result : Item) is 

begin 

Result := Front_Of(The_Queue); 
end Front_0f; 

— end of modification 

function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 
Left_Index : Structure := Left.The_Front; 

Right_Index ; Structure := Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index,The_Itern /- Right_Index.The_Item then 
return False; 

else 

Left_Index Left_Index.Next; 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

return {Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Egual; 

function Length_Of (The_Queue : in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure ;= The_Queue.The^Front; 
begin 

while Index /= null loop 
Count 2 = Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Length_Of; 

function Is_Enpty (The^Queue ; in Queue) return Boolean is 
begin 

return {The_Queue.The^Front = null); 
end Is_.Empty; 

function Front_Of (The_Queue : in Queue) return Item is 
begin 

return The^Queue.The_Front.The_Item; 
exception 

when Constraint^Error => 
raise Underflow; 
end Front__Of; 

procedure Iterate (Over_'Ihe_Queue ; in Queue) is 

The_Iterator : Structure := Over_The_Queue.The_Front; 
Continue : Boolean; 

begin 

while not (The_Iterator = null) loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The^Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end 

Queue JNfonpr ior i ty_Nonbalking_Sequen t ial_Unbounded^Unmanaged_I terator 
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QVEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 


PSDL 


TYPE 

Queue_Nonpr ior i ty_Nonbalking_Sequent i al_Unbounde<i_Uninanaged^I t er a 10 r 

SPECIFICATION 

GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Frortv_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

Th€_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Queue, 


Right ; Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is^Enpty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolecin 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : inft : Item], Continue : out[t 

Boolean]] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue_Nonpriority_Nonbalking_Seguential__Unbounded_UninanagecLIterator 

END 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function Priority^Of (The_Item ; in Item) return 

Priority; 

with function "<=" {Left : in Priority; 

Right : in Priority) return Boolean; 
package Queue_Priority_Balking_Sequential_UnboundedLUninanaged_Iterator 
is 

type Queue is limited private; 

procedure Copy (From_The_Queue : in Queue; 

To_The_Queue ; in out C^eue); 

procedure Clear {The_Queue : in out Queue); 

procedure Add (The^Item : in Item; 

To_The_Queue : in out Queue); 

procedure Pop (The_Queue : in out Queue); 

procedure Remove^Item (FronuThe_Queue : in out Queue; 

At_The_Position : in Positive); 

function Is_Equal {Left : in Queue; 

Right : in Queue) return Boolean; 

fimction Length_Of {The_Queue : in Queue) return Natural; 


function Is_Einpty {The«.Queue : in Queue) return Boolean; 

function Front_,Of (The_Queue : in Queue) return Item; 

function Position_Of (The_Item : in Item; 

In_The_Queue ; in Queue) return Natural; 

generic 

with procedure Process (The^Item : in Itern; 

Continue : out Boolean); 
procedure Iterate (Over_The_Queue ; in Queue); 

Overflow : exception; 

Underflow : exception; 

Position_Error ; exception; 

private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : Structure; 
end record; 

end Queue_Priority_Balking_Seguential_Unbounded_Unmcinaged_Iterator; 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA IMPLEMENTATION 


-- (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nuniber 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is sxibject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

—• Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package boc^ 

Queue_Priority_3alking_Sequential_UnboundecLUnitianaged_lterator is 

type Node is 
record 

The_Item : I tern; 

Next : Structure; 

end record; 


procedure Copy (From_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
Fronulndex : Structure := Froin_The_Queue.The_Front; 
To_Index : Structure; 
begin 

if Froin_The_Queue.The^Front = null then 
To_The_Queue.The_Front := null; 

To„The_Queue.The_Back := null; 

else 


To_The_Queue. The_Front : = 

new Node' {The_Itern => FroituIridex.The_Item, 

Next => null); 

To_The_Queue. The_Back ;= To_The_Queue. The_Front; 
To_Index := To_The_Queue,The_Front; 

From^Index := Frorn_Index.Next; 
while Frorn_Index /= null loop 

To_Index.Next := new Node' (The_Item => 
Froin_Index. The_Item, 

Next => null); 


To__Index := To_Index.Next; 
Fronulndex Frorn_Index. Next; 
To_The_Queue.The_Back ;= To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue := Queue'(The„Front => null, 
The_Back => null); 

end Clear; 


procedure Add (The_Item : in Item; 

To_The_Queue : in out Queue) is 
Previous : Structure; 

Index ; Structure := To_The_Queue.The_Front; 
begin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front ;= new Node'(The_Itern => The_Item, 

Next => null); 

To_The_Queue.The_Back := To_The_Queue.The_Front; 

else 

while (Index /= null) and then 
(Priority_Of(The_Item) <= 

Priority_Of (Index. The_Itern)) loop 
Previous := Index; 

Index := Index.Next; 
end loop; 

if Previous = null then 

To_The_Queue.The_Front := 

new Node’{The_Item => The_Item, 

Next => Index); 

if To_The_Queue.The_Back = null then 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
end if; 

elsif Index = null then 

To_The_Queue.The_Back .Next : = new Node' {The_Item = > 


The_Item, 


Next => 


To_The_Queue.The_Back To_The_Queue.The^Back,Next; 

else 

Previous .Next := new Node' (The_Item => The_Item, 

Next => Index); 

end if; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 


procedure Pop (The_Queue : in out Queue) is 


begin 

The_Queue.The_Front := The_Queue.The_Front.Next; 
if The_Queue.The_Front = null then 
Thc_Queue.The_Back i- null; 
end if; 
exception 

when Constraint_Error *> 
raise Underflow; 

end Pop; 

procedure Remove_Itein (FroituThe_Queue : in out Queue; 

At_The_Position ; in Positive) is 
Count ; Natural := 1; 

Previous : Structure ,- 

Index ; Structure ;= From_The_Queue.The_Front; 
begin 

while Index /= null loop 

if Count = At_The_Position then 
exit; 

else 

Count ;= Count +1; 

Previous ;= Index; 

Index := Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position^Error; 
elsif Previous = null then 

FronuThe_Queue.The_Front := Index.Next; 

else 

Previous.Next := Index.Next; 
end if; 

if Fron\_The_Queue.The_Back = Index then 
FrortuThe_Queue.The_Back := Previous; 
end if; 

end Remove_Item; 

modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_Equal (Left 
Right 
Result 

begin 

Result := Is_Egual(Left,Right); 
end Is_Equal; 

procedure Length_0f (The_Queue 
Result 

begin 

Result := Length_Of(The_Queue); 
end Length_0f; 

procedure Is_Eripty (The_Queue 

Result 

begin 

Result : = Is_Einpty (The_Queue) ; 
end Is^Enpty; 

procedure Front_Of {The_Queue 

Result 

begin 

Result := Front_Of(The^Queue); 
end Front_Of; 

procedure Position_Of (The_Item 

In_The_Queue 
Result 

Ijegin 

Result := Position_Of(The_Item,In_The_Queue); 
end Position_Of; 

end of modification 

function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 
Left_Index : Structure := Left.The_Front; 

Right_Index : Structure := Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index.The_Item /= Right_Index.The_Item then 
return False; 

else 

Left^Index := Left_Index.Next; 

Right_Index :s: Right_Index.Next; 
end if; 
end loop; 

return {Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is^Egual; 

function Length_Of {The_Queue : in Queue) return Natural is 
Coxjnt : Natural := 0; 

Index : Structure := The_Queue.The_Front; 
begin 

while Index /= null loop 


: in Queue; 

: in Queue; 

; out Boolean) is 


: in Queue; 

: out Natural) is 


: in Queue; 

: out Boolean) is 


; in Queue; 
; Item) is 


: in Item; 

: in Queue; 

: out Natural) is 
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Count := Coxant * 1; 

Index ;= Index.Next; 
end loop; 
return Count; 
end Length^Of; 

function Is^Errpty (The^Queue : in Queue) return Boolean is 
begin 

return (The_Queue,The_Front » null); 
end Is_Eitipty; 

function Pront_Of (The_Queue : in Queue) return Item is 
begin 

return The_Queue.The_Front.The_Itern; 
exception 

when Constraint^Error =s> 
raise Underflow; 
end Front_Of; 

function Position_Of (The_Item : in Item; 

In_The_Queue : in Queue) return Natural is 
Position : Natural := 1; 

Index : Structure := In_The_Queue.The_Front; 
begin 


while Index /= null loop 

if Index.The_Itern = The_,Item then 
return Position; 

else 

Position Position + 1; 

Index ;= Index.Next; 
end if; 
end loop; 
return 0; 
end Position_0f; 

procedure Iterate (Over_The_Queue : in Queue) is 

The_Iterator : Structure ;= Over__The_Queue. The^Front; 
Continue : Boolean; 
begin 

while not (The„Iterator = null) loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The^Iterator ;= The_Iterator.Next; 
end loop; 
end Iterate; 

end Queue_Priority_Balking_Seguential_Unboxinded_Unmanaged_Iterator; 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

PSDL 


TYPE Queue_Priority_Balking__Sequential_Unbounded^Unmanaged_Iterator 

SPECIFICATION 

GENERIC 

Item ; PRIVATE_TYPE, 

Priority : PRIVATE_TYPE, 

Priority_Of : FUNCTION[The_Itern : Item, RETURN ; Priority], 
func_"<=" : FUNCTION {Left : Priority, Right ; Priority, RETURN 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Queue ; Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

FrortuThe__Queue : Queue, 

At_The_Position : Positive 
OUTPUT 

From_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is^Equal 
SPECIFICATION 
INPUT 


Left : Queue, 

Right ; Queue 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue t Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Einpty 

SPECIFICATION 

INPUT 

The^Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Position^Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In^The_Queue : Queue 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : inU : Item], Continue : out[t 

Boolean]] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue_Priority_Balking_Seguential_Unbounded_Unmanaged_Iterator 

END 
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QUEUE PRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function Priority_Of {The_Item : in Item) return 
Priority; 

with function •<=" (Left : in Priority; 

Right ; in Priority) return Boolean; 

package 

Queue_Pr ior i ty^JIonbalking^Sequent i al_Unbounde(i_Uninanaged_I ter a tor xs 
type Queue is limited private; 

procedure Copy (FroiiL.The_Queue ; in Queue; 

To_The_Queue ; in out Queue); 
procedure Clear {The_Queue : in out Queue); 

procedure Add (The_Item : in Item; 

To_The_Queue : in out Queue); 
procedure Pop {The_Queue : in out Queue); 

— modified by Tuan Nguyen 

— replacing functions with procedures 

procedure Is_Egual (Left : in Queue; 

Right ; in Queue; 

Result : out Boolean); 

procedure Length_Of (The_Queue ; in Queue; 

Result : out Natural); 

procedure Is^En^Jty {The_Queue : in Queue; 

Result : out Boolean); 


procedure Front_Of (The^Queue : in Queue; 

Result : Item) ; 

— end of modification 

function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean; 

function Length_Of (The_Queue : in Queue) return Natural; 

function Is^Enpty (The_Queue : in Queue) return Boolean; 

fxinction Front_Of (The_Queue : in Queue) return Item; 

generic 

with procedure Process (The_Item ; in Item; 

Continue : out Boolean); 
procedure Iterate (Over_The_Queue : in Queue); 

Overflow : exception; 

Underflow : exception; 

private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front ; Structure; 

The_Back : Structure; 
end record; 

end Queue_PriorityJNonbalking_Seguential_Unbounded_Unmanaged_Iterator 
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QUEUE PRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nuiriber 0100219 

"Restricted Rights Legend" 

-- Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


Queue_Priority_Nonbalking_Seguential_Unbounded_Uninanaged_Iterator 

is 


type Node is 
record 

The_Item : Item; 

Next : Structure; 

end record; 


procedure Copy (Fron\_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
Froituindex : Structure := FroitL.The_Queue .The_Front; 
To_Index ; Structure; 
begin 

if FroiruThe_Queue. The^Front = null then 
To_The_Queue.The_Front := null; 
To_The_Queue.The_Back := null; 

else 

To_The_Queue.The_Front := 

new Node' (The_Item => Fron\_Index.The_Item, 

Next => null); 

To_The_Queue. The_Back : = To_The_Queue. The_Front ; 
To_Index ;= To_The_Queue.The_Front; 

Fronulndex := Fronuindex,Next; 
while Fronulndex /= null loop 

To_Index.Next ;= new Node' {The_Item => 


From_Index. The_Item, 


Next => null); 


To_Index := To_Index.Next; 
FroiTL.Index := From^Index. Next; 
To_The_Queue.The_Back := To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue ;= Queue’(The_Front => null, 
The^Back => null); 

end Clear; 


procedure Add (The^Item : in Item; 

To_The_(3ueue : in out Queue) is 
Previous : Structure; 

Index : S true fore := To_The_Queue. The_Front; 
begin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front := new Node' (The^Item ==> The^Item, 
““ Next => null) ; 

To_The_Queue - The_Bac k : = To_The_Queue. The_Front; 

else 

while (Index /= null) and then 
(Priority_Of(The_Item) <= 

Prior ity_Of (Index. The_Item)) loop 
Previous := Index; 

Index := Index.Next; 
end loop; 

if Previous = null then 

To_The_Queue.The^Front := 

new Node' (The^Item => The_Item, 

Next => Index) ; 
if To_The_Queue.The_Back = null then 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
end if; 

elsif Index = null then 

To_The_Queue,The_Back.Next := new Node' (The_Item => 


The^Item, 


Next => 


To_The_Queue.The_Back :« To_The_Queue.The_Back.Next; 

else 

Previous.Next := new Node'(The_Itern => The_Item, 

Next => Index); 

end if; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 


procedure Pop (The^Queue : in out Queue) is 
begin 

The_Queue.The_Front := The_Queue.The_Front.Next; 
if The_Queue.The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

— modified by Tuan Nguyen 
-- replacing fimctions with procedures 

procedure Is_Egual (Left 
Right 
Result 

begin 

Result := Is_Egual(Left,Right); 
end Is_Equal; 

procedure Length_0f (The_Queue 
Result 

begin 

Result :s Length_0f(The^Queue); 
end Length_0f; 

procedure Is_Enpty {The_Queue 

Result 

begin 

Result := Is_Eitpty(The_Queue) ; 
end Is_Errgpty; 

procedure Front_Of (The^Queue 

Result 

begin 

Result := Front^Of(The_Queue); 
end Front_Of; 

— end of modification 

function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 
Left^Index : Structure := Left.The_Front; 

Right_Index : Structure := Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index.The_Itern /= Right_Index.The_Item then 
return False; 

else 

Left_Index ;= Left_Index.Next; 

Right^Index := Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

fxinction Length_Of (The_Queue : in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure := The_Queue.The_Front; 
begin 

while Index /= null loop 
Count ;= Count + 1; 

Index := Index.Next; 
end loop; 
return Co^mt; 
end Length_Of; 

function Is^Enpty (The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = null); 
end Is_En^ty; 

function Front_Of (The_Queue : in Queue) return Item is 
begin 

retvim The_Queue. The_Front. The^Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Front_Of; 

procedure Iterate (Over^The_Queue : in Queue) is 

The_Iterator : Structure Over_The_Queue. The_Front ; 

Continue : Boolean; 

begin 

while not (The_Iterator = null) loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end Queue_Priority_Nonbalking_Seguential_UnboundedLUninanaged_Iterator 


: in Queue; 

: in Queue; 

: out Boolean) is 


: in Queue; 

; out Natural) is 


: in Queue; 

: out Boolean) is 


; in Queue; 
: Item) is 
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QUEUE PRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 


PSDL 


TYPE Queue_Priority_Nonbalking_Sequential_UnboTJiidecLUnmcinaged_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TyPE, 

Priority : PRIVATE_TYPE, 

Priority_Of : FUNCTION[The_Item : Item, RETURN : Priority], 
func_"<=" : FUNCTIONILeft : Priority, Right : Priority, RETURN : 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

Fron\_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item ; Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Empty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The^Itern : in[t : Item], Continue : out(t 

Boolean]] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue_Priority_Nonbalking_Sequential_UnboundecLUninanaged_Iterator 

END 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

Queue^^Nonpriority_Balking^Sequential_Unbounde<01anaged_Iterator is 


type Queue is limited private; 


procedure Copy 

procedure Clear 
procedure Add 

procedure Pop 
procedure Remove_Item 


{Froir\_The_Queue 
To_The_Queue 
(The^Queue 
(The_Item 
To_The_Queue 
{The_Queue 
{FroiiL_The_Queue 
At_The_Position 


in Queue; 
in out Queue); 
in out Queue); 
in I tern; 
in out Queue); 
in out Queue); 
in out Queue; 
in Positive); 


modified by Tuan Nguyen 


replacing 

functions 

with procedures 


procedure 

Is_Equal 

(Left 

in Queue; 



Right 

in Queue; 



Result 

out Booleaui) 

procedure 

Length_Of 

{The_Queue 

in Queue; 


Result 

out Natural) 

procedure 

Is_En 5 >ty 

(The_Queue 

in Queue; 


Result 

out Boolean) 

procedure 

Front_Of 

(The_Queue 

in Queue; 


Result 

Item); 

procedure 

Position_Of (The^Item 

in Item; 


In_The_Queue ; 

in Queue; 


Result 


out Natural); 


end of modification 


function ls_Equal 

function Length_Of 
function Is_Enpty 
fimction Front_Of 
function Position_Of 


(Left 

Right 

(The_Queue 

(The_Queue 

(The_Queue 

(The_Item 

In_The„Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 
in Item; 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
return Itern; 

return Natural; 


generic 

with procedure Process (The_Item ; in Item; 

Continue : out Booleain) ; 
procedure Iterate {Over_The_Queue : in Queue); 


Overflow : exception; 
Underflow : exception; 
Position_Error : exception; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : Structure; 
end record; 

end Queue_Nonpriority_Balking_Se(3uential_UnboundedJWanaged_Iterator 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

“Restricted Rights Legend" 

— Use, duplication, or disclosure is sxibject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Cort?3uter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage^anager_Sequential; 
package body 

Queue_JJonpriority_Balking_Seq[uential_Unbounded^Mcmaged_Iterator is 

type Node is 
record 

The_Item : Itern; 

Next ; Structure; 

end record; 

procedure Free {The_^ode : in out Node) is 
begin 

null; 
end Free; 

procedure Set^Next (The^Node : in out Node; 

To_Next : in Structure) is 

begin 

The_Node .Next ;= ToJtJext; 
end Set_JText; 

function Next_Of (The_Node : in Node) return Structure is 
begin 

return The_Node.Next; 
end Next_Of; 

package Node_Manager is new StorageJManager_Sequential 

(Item => Node, 

Pointer => Structure, 

Free => Free, 

Set_Pointer => Set_Next, 
Pointer„Of => Next_0f); 

procedure Copy (From_The_Queue : in Queue; 

To_The_Queue ; in out Queue) is 
From_Index : Structure := FroiiuThe_Queue. The_Front ; 
To^Index : Structure; 
begin 

NodeJManager.Free(To_The_Queue.The_Front >; 
To_The_Queue.The_Back ;= null; 
if FroiiL.The_Queue. The_Front /= null then 

To_The_Queue. The_Front : = Node_Manager. New_ltern; 
ToZThelQueue.TheZsack := To_The_Queue-The_Front; 
To_The_Queue.The_Front.The_Item := From^Index.The_Item; 
To^Index := To_The_Queue-The_Front; 

Froit\_Index := Froni_Index.Next; 
while Fronulndex /= null loop 

To_lndex.Next := Node_Manager.New_Item; 

ToZindex.Next.The_Itern ;= FronuIndex.The_Item; 
To_Index := To_Index.Next; 

Fronuindex := From_Index.Next; 

To^The_Queue.The_Back := To_Index; 
end loop; 
end if; 
exception 

when Storage^Error => 
raise Overflow,- 
end Copy; 

procedure Clear (The^Queue : in out Queue) is 
begin 

Node_Manager.Free(The_Queue.The_Front); 

The_Queue.The_Back := null; 
end Clear; 


procedure Add (The_Item : in Item; 

To_The_,Queue ; in out Queue) is 

begin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front := NodeJIanager-New_Item; 
To_TheZQueue.The_Front.The_ltem := The_Item; 
To_The_Queue.The_Back := To_The_Queue.The_Front; 

else 

To_The_Queue. The_Back. Next : = Node_Manager. New_I tem ; 
To_The_Queue.The^Back.Next,The_Itern:= The_Itern ; 
To_The_Queue.The_Back := To_The_Queue.The_Back.Next; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Pop (The^Queue : in out Queue) is 
Tenporary_Node : Structure; 


begin 

Teniporary_JIode := The_Queue. The_Front; 

The_Queue.The_Front := The_Queue.The_Front.Next; 
TemporaryJJode.Next := null; 

NodeJManager .Free (Teirporary_Node); 
if ThejQueue.The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when ConstraintjError => 
raise Underflow; 

end Pop; 

procedure Remove_Item (Froii\_ThejQueue : in out Queue; 

AtjThejPosition ; in Positive) is 
Count : Natural := 1; 

Previous : Structure; 

Index : Structure := FroituThejQueue.The_Front ; 
begin 

while Index /= null loop 

if Count = AtjThe_Position then 
exit; 

else 

Count ;= Count + 1; 

Previous ;= Index; 

Index := Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position_Error; 
elsif Previous = null then 

FroiiuThe_Queue. The^Front : = Index. Next; 

else 

Previous.Next := Index.Next; 
end if; 

if From_ThejQueue.The_Back = Index then 
From_ThejQueue.The_Back := Previous; 
end if; 

Index.Next ;= null; 

Node^anager. Free (Index) ; 
end Remove_Item; 

modified by Tuan Nguyen 
replacing f\mctions with procedures 

procedure Is_Equal (Left : in Queue; 

Right : in Queue; 

Result : out Boolean) is 

begin 

Result ;= ISjEgual(Left,Right); 
end ISjEqual; 

procedure Length^Of (The^Queue : in Queue; 

Result : out Natural) is 

begin 

ResuIt :» LengthjOf(ThejQueue); 
end LengthjOf; 

procedure Is_.Einpty (The_Queue : in Queue; 

Result : out Boolean) is 

begin 

Result := ISjEmpty(The_Queue); 
end ISjEmpty; 

procedure Front_Of (The_Queue : in Queue; 

Result : Item) is 

begin 

Result ;= FrontjOf(The_Queue); 
end FrontjOf; 

procedure PositioUjOf (The_Item : in Item; 

InjThe_Queue : in Queue; 

Result : out Natural) is 

begin 

Result := Position_0f(The_Item,InjThe_Queue); 
end Position_Of; 

end of modification 

function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 
Leftjindex : Structure := Left.The^Front; 

Rightjindex : Structure := Right.The_Front; 
begin 

while Leftjindex /= null loop 

if LeftjIndex.ThejItem /= Right_Index.ThCjItem then 
return False; 

else 

LeftjIndex Left^Index.Next; 

Rightjindex := Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when ConstraintjError => 
return False; 
end ISjEqual; 





function Length_Of {The_Queue : in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure := The_Queue.The_Front; 
begin 

while Index /= null loop 
Coiint := Count + 1; 

Index index.Next; 

end loop; 
return Count; 
end Length^Of; 

function Is„En?)ty (The^Queue : in Queue) return Boolean is 
iDegin 

return (The_Queue.The_Front = null); 
end Is_Etnpty; 

function Front^Of (The_Queue : in Queue) return Item is 
begin 

return The_Queue. The_Front, The_Item ; 
exception 

when Constraint_Error => 
raise Underflow; 
end Front_0f; 

function Position_0f (The_Item : in Item; 

In_The_Queue : in Queue) return Natural is 


Position : Natural := 1; 

Index : Structure := In_The_Queue.The_Front; 
begin 

while Index /= null loop 

if Index.The_Item = The_Item then 
return Position; 

else 

Position := Position + 1; 

Index := Index.Next; 
end if; 
end loop; 
return 0; 
end PositionwOf; 

procedure Iterate {Over_The_Queue : in Queue) is 

The_Iterator : Structure := Over_The_Queue.The_Front ; 
Continue : Boolean; 

begin 

while not (The_Iterator = null) loop 

Process(The_Iterator.The_Item. Continue); 
exit when not Continue; 

The^Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end QueueJNonpriority_Bal)cing_Sequential_Unbounded_JlanagecLIterator 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 


PSDL 


TTPE Queue_J^onpriorxty_Balking_Sequential_Uiibounde<iJManaged_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuThe^Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue ; Queue 
OUTPUT 

To_The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

FroiruThe_Queue : Queue, 

At_The^Position : Positive 
OUTPUT 

Fromjrhe_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Queue, 

Right : Queue 


OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Is_Einpty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front^Of 

SPECIFICATION 

INPUT 

The^Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Positioti_Error 

END 

OPERATOR Position_Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In_The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDUREITh€_Item : init : Item], Continue : outit 
Boolean]1 
INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue_Nonpr iori ty_Balking_Sequential_Uiibo\jndedJlanaged_I terator 
END 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

Queue_^^onpr i or i ty_Balking_Sequen t ia l_UnboundecLUnmanaged_Non 11 er a t or 

is 

type Queue is limited private; 

procedure Copy (From_The_Queue 

To_The_Queue 

procedure Clear (The_Queue 

procedure Add (The^ltem 

To„The_Queue 

procedure Pop (The_Queue 

procedure Remove_Item (Fronv_The_Queue 
At_The_Position 

— modified by Tuan Nguyen 

— replacing functions with procedures 

procedure Is_Egual (Left : in Queue; 

Right : in Queue; 

Result : out Boolean); 

procedure Length_Of (The_Queue : in Queue; 

Result : out Natural); 

procedure Is_En^ty (The^Queue : in Queue; 

Result : out Boolean); 

procedure Front^Of (The^Queue : in Queue; 

Result : Item); 


: in Queue; 

: in out Queue); 

: in out Queue); 

: in Item; 

: in out Queue); 

: in out Queue); 

: in out Queue; 

: in Positive); 


procedure Position_Of (The_Item : in Item; 

In_The_Queue : in Queue; 

Result : out Natural); 

— end of modification 

function Is^Ec[ual (Left 
Right 

function Length_Of (The_Queue 

function Is_Enpty (The_Queue 

f\inction Front_Of (The_Queue 

function Position_Of (The_Item 

In_The_Queue 

Overflow : exception; 

Underflow ; exception; 

Position^Error : exception; 

private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : Structure; 
end record; 

end 

Queue_JNonpriority_Balking„Sequent ial_Unbounded_Unmanaged_Noni terator 


; in Queue; 

: in Queue) return Boolean; 

: in Queue) return Natural; 

: in Queue) return Boolean; 

; in Queue) return Item; 

: in Item; 

; in Queue) return Natural; 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


-- (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Ntamber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision {b} (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body 

Queue_Monpr ior i ty_Balking_Sequen t ia l_Unbounded_Uninanage(l_Noni ter a tor 
is 


else 

Count := Count + 1; 

Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position_Error; 
elsif Previous = null then 

FroiiL_The_Queue.The_Front := Index.Next; 

else 

Previous.Next := Index.Next; 
end if; 

if FronL.The_Queue.The_Back = Index then 
FrortL.The_Queue.The_Back := Previous; 
end if; 

end Remove_Itern; 


type Node is 
record 

The_Item : Itern; 

Next : Structure; 
end record; 


procedure Copy (FronuThe_Queue : in Queue; 

To_The_Queue ; in out Queue) is 
From_Index : Structure := Proin_The_Queue.The_Front; 
To_lndex ; Structure; 
begin 

if From_The_Queue.The_Front = null then 
To_The_Queue.The_Front := null; 

To_The_Queue,The_Back := null; 

else 


To_The_Queue.The_Front := 

new Node' (The_Item => From_Index.The_Item, 

Next => null); 

To_The_Queue.The^Back := To_The_Queue,The_Fron t; 
To^Index ;= To_The_Queue.The_Front; 

Frortuindex := From^Index.Next; 
while From_Index /= null loop 

To_Index.Next := new Node *(The_Itern => 
Froiruindex. The_I t em, 

Next => null); 


To_Index := To_Index.Next; 
From_lndex := From_Index*Next; 
To.._The_Queue. The_Back : = To^Index ; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is^Equal (Left : in Queue; 

Right : in Queue; 

Result ; out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Egual; 


procedure Length-Of (The_Queue : in Queue; 

Result : out Natural) is 

begin 

Result := Length_Of(The^Queue); 
end Length-Of; 

procedure Is_Eitpty (The_Queue : in Queue; 

Result ; out Boolean) is 

begin 

Result ; = Is_Ernpty (The_Queue); 
end Is_En^ty; 


procedure Front_0f (The_Queue : in Queue; 

Result : Item) is 

begin 

Result := Front_0f(The_Queue); 
end Front_Of; 


procedure Position_Of 


(The_Item 

In_The_Queue 

Result 


in Item; 
in Queue; 
out Natural) 


begin 

Resu1t ;= Position_Of{The_Item,In_The_Queue); 
end PositionjOf; 


is 


procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue := Queue'(The_Front => null, 
The_Back => null); 

end Clear; 


procedure Add {The_Item : in Item; 

To_The_Queue : in out Queue) is 


begin 

if To_The_Queue.The_Front *= null then 

To_The_Queue.The_Front := new Node* (The_Item => The_Item, 

Next => null); 

To_The_Queue.The_Back := To_The_Queue.The_Front; 


else 

To_The_Queue.The_Back.Next 


new Node *(The_Item => 


The_Item, 


To_The_Queue.The_Back 
end if; 
exception 

when Storage_Error «=> 
raise Overflow; 


Next => null); 
To._The^Queue. The_Back. Next; 


end Add; 


procedure Pop (The_Queue : in out Queue) is 
begin 

The_Queue.The_Front := The_Queue.The_Front.Next; 
if The_Queue-The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

procedure Remove^Item (Fron\jnie_Queue : in out Queue; 

At_The_Position : in Positive) is 
Count : Natural := 1; 

Previous : Structure; 

Index : Structure := FrorcL_The_Queue .The^Front; 
begin 

while Index /= null loop 

if Coimt = At^The_Position then 
exit ; 


end of modification 

fxinction Is_Equal (Left : in Queue; 

Right : in Queue) return Boolean is 
Left_Index Structure := Left .The_Front; 

Right_lndex : Structure ;= Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index.The_Item /- Right_Index.The_Item then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_Index ;= Right^Index.Next; 
end if; 
end loop; 

return (Right^Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length_Of (The_Queue : in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure The_Queue.The_Front; 
begin 

while Index /= null loop 
Coimt Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Length^Of; 

fimction Is_Eirpty (The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = null); 
end Is_Etrpty; 

function Front_0f (The_Queue : in Queue) return Item is 
begin 

return The_Queue.The_Front-The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Front_Of; 
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function Position_Of (The_Item : in Item? 

ln_The_Queue : in Queue) return Natural is 
Position : Natural := 1; 

Index ; Structure ;= In_The_Queue.The^Front? 
begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 
return Position; 

else 


Position ;= Position 
Index := Index.Next; 
end if; 
end loop; 
return 0; 
end Position_0f; 


end 

Queue_Nonpr ior i ty_Balking_Seq[uent ia 1. 


_Unboundecl_UrananagecUNoni ter ator; 
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QUEUE NONPRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 


PSDL 


TYPE 

Queue_JJonpriority_Balking_Sequential_UnboundecfLUnmanaged_Noniterator 

SPECIFICATION 

GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Queue : Queue, 

To_The_Queue ; Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue ; Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The„Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

FroirL.The_Queue ; Queue, 

At„The_Position : Positive 
OUTPUT 

From_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 


OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left ; Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Length^Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR ls_Eirpty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Position^Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In_The_Queue : Queue 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue^Nonpr ior i ty_Ba lking_Se<3uen t ial«.Unbounded_Uninanageci_Noni tera tor 

END 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 
package 

Queue_Nonpriority_Nonbalking_Seguential_Unbounded_UnmanagedJIonxterato 

r 

is 

type Queue is limited private; 

procedure Copy {From_The_Queue 
To_The_Queue 

procedure Clear (The^Queue 
procedure Add (The_Item 

To_The_Queue 

procedure Pop (The_Queue 

— modified by Tuan Nguyen 

— replacing functions with procedures 

procedure Is^Equal (Left : in Queue; 

Right : in Queue; 

Result : out Boolecin) ; 

procedure Length_Of {The_Queue : in Queue; 

Result : out Natural); 

procedure Is_En?5ty (The^Queue : in Queue; 

Result : out Boolean); 


: in Queue; 

: in out Queue); 
: in out Queue); 
: in Item; 

: in out Queue); 
: in out Queue); 


procedure Front_Of (The_Queue : in Queue; 

Result : Item); 

— end of modification 

function Is_Equal (Left 
Right 

fxinction Length^Of (The_Oueue 
fiinction Is_Empty (The^Queue 
function Front_Of (The_Queue 

Overflow : exception; 

Underflow : exception; 

private 

type Node; 
type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : Structure; 
end record; 

end 

Queue JNonpr ior i ty_Nonba Iking^Sequent i a l_Unbounded_Unmanage(UIoni t er a t o 


: in Queue; 

: in Queue) return Boolean; 
; in Queue) return Natural; 
: in Queue) return Boolean; 
: in Queue) return Item; 


168 




QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Cort^juter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body 

QueueJNonpriority_JIonbalking_Sequential_Unbounded_Unnianaged_Noniterato 

r is 


type Node is 
record 

The_Item : I tern; 

Next : Structure; 

end record; 


procedure Copy (FroiruThe_Queue : in Queue; 

To_The_Queue : in out Queue) is 
Fron\_Index ; Structure := FroiiuThe_Queue.The_Front; 
To_Index : Structure; 
begin 

if FronuThe_Queue.The_Front = null then 
To_The_Queue.The_Front := null; 

To_The_Queue.The_Back := null; 

else 


To_The_Queue.The_Front := 

new Node*(The„Itern => From_Index.The_Item, 

Next => null); 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
To_Index := To_The_Queue.The_Front; 

FroirL,Index := Frorn_Index.Next; 
while From_Index /= null loop 

To_Index.Next := new Node * (The^Itern => 
From_Index, The_I t em, 


Next => null); 


To_Index := To_Index.Next; 
From^Index : = Fron\_Index. Next ; 
To_The_Queue.The_Back := To_Index; 


end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 


end Copy; 


procedure Clear (The_Queue : in out Queue) is 
begin 

The_jQueue := Queue* (The_Front => null, 
The_Back => null); 

end Clear; 


procedure Add (*rhe_Item : in Item; 

To_The_Queue : in out Queue) is 

begin 

if To_The_Queue .'rhe_Front = null then 

Tojrhe_Queue.The_Front := new Node'{The_Itern => The_Item, 

Next => null); 

To_The_Queue. The^ack : = To_The_Queue. The_Front; 

else 

To_The_Queue. The_Back. Next := new Node' (The_Itern => 


The^Item, 


Next => null); 


To_The_Queue.The_Back := To_The_Queue.The_Back. Next ; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 


end Add; 


procedure Pop (The^Queue : in out Queue) is 
begin 

The_Queue.The_Front := The^Queue.The^Front.Next; 
if ThejQueue.The^Front = null then 
The_.Queue.The_Back := null; 


end if; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

— modified by Tuan Nguyen 

— replacing functions with procedures 

procedure Is_Equal (Left : in Queue; 

Right : in Queue; 

Result : out Boolean) is 

begin 

Result := Is^Equal(Left,Right); 
end Is_Equal; 

procedure Length_0f (The^Queue : in Queue; 

Result : out Natural) is 

begin 

Result ;= Length_Of ('The^Queue) ; 
end Lengtb-Of; 

procedure Is_Ernpty (The_Queue : in Queue; 

Result : out Boolean) is 

begin 

Result := Is_Empty(The^Queue); 
end Is_Empty; 

procedure Front_0f (The_Queue : in Queue; 

Result : Item) is 

begin 

Result := Front_Of(The^Queue); 
end Front_Of; 

— end of modification 

function Is_Equal (Left : in Queue; 

Right : in Queue) return Boolecui is 
Left_Index : Stanacture := Left .The_Front; 

Right_Index ; Structure := Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index.The_.Item /- Right_Index.The_Item then 
return False; 

else 

Le f t_Index := Left_Index.Next; 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length_0f (The_Queue : in Queue) return Natural is 
Count : Natural ;= 0; 

Index : Structure := The_Queue.The_Front; 
begin 

while Index /= null loop 
Coxjnt ;= Count + 1; 

Index :=: Index.Next; 
end loop; 
return Co\mt; 
end LengthwOf; 

function Is_Eirpty (The_Queue ; in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = null); 
end Is_Empty ; 

fainction Front_Of (The_Queue : in Queue) return Item is 
begin 

return The_Queue.The_Front.The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Front_Of; 

end 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Unmanaged_Nonxterato 
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QUEUE NONPRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

PSDL 


Queue_Nonpriority_Noiibalking_Sequential_Unbotinded^Unmanaged_Noniterato 

r 

SPECIFICATION 

GENERIC 

Item : PRIVATE_TYPE 

OPERATOR Copy 

SPECIFICATION 

INPUT 

FrortuThe_Queue : Queue, 

To_The„Queue : Queue 
OUTPUT 

To_The„Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 

SPECIFICATION 

INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 


OPERATOR Is^Equal 

SPECIFICATION 

INPUT 

Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Empty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue JNonpr ior x ty_Nonbalking_Sequent ial_Unboimded^Unmanaged_Noni t er a t o 

r 

END 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function Priority_Of (The_Item : in Item) return 

Priority; 

with function "<=" (Left : in Priority; 

Right : in Priority) return Boolean; 
package Queue_Priority_Balking_Sequential_Unbounded_Managed_Iterator 
is 


type Queue is limited private; 


procedure Copy 

(FroauThe_Queue : 

in 


Queue; 


To_The_Queue ; 

in 

out 

Queue); 

procedure Clear 

(The_Queue : 

in 

out 

Queue); 

procedure Add 

{The_Item : 

in 


Item; 


To_The_Queue ; 

in 

out 

Queue); 

procedure Pop 

(The_Queue : 

in 

out 

Queue); 

procedure Remove_Item {Froirt.The_Queue : 

in 

out 

Queue; 


At_The_Position : 

in 


Positive) 

modified Tuan Nguyen 




replacing functions 

with procedures 




procedure Is_Equal 

(Left : in 

Queue; 



procedure Length_Of 
procedure Is_Enpty 
procedure Front^Of 


Right 

Result 

(The^Queue 

Result 

(The_Queue 

Result 

{The_Queue 

Result 


; in Queue; 

: out Boolean); 
: in Queue; 

: out Natural); 
: in Queue; 

: out Boolean); 
: in Queue; 

: Item) ; 


procedure Position^Of (The_Item : in Item; 

In_The_Queue : in Queue; 
Result ; out Natural); 


end of modification 

function Is_Equal 

(Left : 

in (Jueue; 



function Length_Of 

Right ; 

in Queue) 

return 

Boolean; 

(The_Queue ; 

in Queue) 

return 

Natural; 

function Is_Eirpty 

(The_Queue : 

in Queue) 

return 

Boolean; 

function Front_Of 
function Position_Of 

(The_Queue : 

(The_Item : 

in Queue) 
in Item; 

return 

Item; 

generic 

In__The_Queue ; 

in Queue) 

return 

Natural; 

with procedure Process (The_Item 

: in Item; 



Continue ; out Boolean); 
procedure Iterate (Over_The_Queue : in Queue); 


Overflow : exception; 

Underflow : exception; 

Position_Error : exception; 

private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The^Back : Structure; 
end record; 

end Queue_Priority_Balking_Sequential_UnboundedJManaged_Iterator ; 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 


ADA IMPLEMENTATION 


-- (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nimber 0100219 

“Restricted Rights Legend" 

-- Use, duplication, or disclosure is subject to 

restrictions as set forth in subdivision (b) (3) (ii) 

_ of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874) 

with storage_Jlanager_Sequential; 

QueuSriority_Balking_Sequential_Unbounded_Managed_Iterator is 

type Node is 
record 

The^Item : Item; 

Next : Structure; 
end record; 

procedure Free (The_>Iode : in out Node) is 
begin 

null; 
end Free; 

procedure SetJNext (TheJIode : in out Node; 

ToJJext : in Structure) is 

begin 

TheJJode,Next To_Next; 

end Set^Next; 

function Next_Of (The^ode : in Node) return Structure is 
begin 

return The_JJode .Next; 
end Next_Of; 

package Node_Nanager is new Storage_Manager_Sequential 

(Item => Node, 

Pointer => Structure, 

Free => Free, 

Set_Pointer => SetJJext, 
Pointer_Of => Next_0f); 

procedure Copy (FroitL_The_Queue : in Queue; 

To_The_Queue ; in out Queue) is 
From_Index : Structure FronuThe_Queue.The_Front; 

To^Index : Structure; 
begin 

NodeJManager.Free{To_The_Queue.The_Front); 

To_The_Queue.The_Back := null; 
if FronuThe^Queue.The_Front /= null then 

1'o_The_Queue. The Front := Node_N3nager .New_Item; 

To The_Queue.The_Back To_The_Queue.The^Front; 

TolThe_Queue.The_Front.The_Item := From_Index.The_Itern; 
To Index := To_The_Queue.The_Front; 

Fronuindex := From_Index.Next; 
while From_lndex /= null loop 

To_Index.Next := NodeJJanager.New_Item; 
To_Index.Next-The_Item := From_Index.The_ltem; 
To_Index := To_Index.Next; 

From_Index := Fronulndex.Next; 
To_The_Queue.The_Back := To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Queue : in out Queue) is 

Node^Manager.Free(The_Queue.The^Front); 

The_Queue.The_Back := null; 
end Clear; 

procedure Add (The_Item : in Item; 

To_The_Queue : in out Queue) is 
Previous ; Structure; ^ 

Index : Structure := To_The_Queue.The_Front; 
i>egin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front := NodeJManager.New^Item; 

To_The Queue.The_Front.The_Itern := The_Item; 
To_ThelQueue. The^Back : = To_The_Queue. The_Fron t ; 
else 

while (Index /= null) and then 
(Priority_0f(The_Itern) <« 

Priority_0f (Index. The_Item)) loop 
Previous Index; 

Index := Index.Next; 
end loop; 

if Previous = null then 

To_The_Queue.The_Front := NodeJIanager.New_Item; 
To_The_Queue.The_Front.The_Item The_Item; 


To_The_Queue.The_Front.Next := Index; 
if To_The__Queue .The_Back = null then 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
end if; 

elsif Index = null then 

To_The_Queue. The_Back. Next : = Node_Jlanager. New_Itern; 
To_The_Queue.The_Back ;= To_The_Queue.The^Back.Next; 
Tojrhe_Queue.The_Back.Th€_It€m := The_Item; 

else 

Previous.Next := Node^cinager.New_Item; 

Previous.Next.The_Itern := The^Item; 

Previous.Next.Next := Index; 
end if; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Pop (The^Queue : in out Queue) is 
Temporary_Node : Structure; 
begin 

Temporary^ode : = The_Queue. The_Front; 

The_Queue.The_Front := The_Queue.The_Front.Next; 
Temporary_Node.Next := null; 

Node_Nanager. Free (TemporaryJ^ode); 
if The_Queue.The_Front = null then 
The_Queue.The^Back := null; 
end if; 
exception 

when Constraint_,Error => 
raise Underflow; 

end Pop; 

procedure Remove_Item (FronuThe_Queue ; in out Queue; 

At_The_Position ; in Positive) is 

Count : Natural := 1; 

Previous : Structure; 

Index : Structure := From_The_Queue.The_Front; 
begin 

while Index /= null loop 

if Count = At_The_Position then 
exit; 

else 

Coiint := Count + 1; 

Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position_Error; 
elsif Previous = null then 

FronuThe_.Queue. The_Front : = Index. Next ; 

else 

Previous.Next := Index.Next; 
end if; 

if From_The->Q»ie'‘ie-Th®-®2ic^ ® Index then 
From_The_Queue.The_Back := Previous; 
end if; 

Index.Next ;= nul1; 

Node Jlanager.Free(Index); 
end Remove_Itern; 


— modified by Tuan Nguyen 

— replacing f\anctions with procedures 


procedure ls_Equal (Left 
Right 
Result 

begin 

Result := Is^Equal(LsfF.ight); 
end Is_Equal; 

procedure Lengths©f (The_Queue 
Result 

begin 

Result := Length_Of(The.Queue); 
end Length^Of; 

procedure Is^Empty (The^Queue 
Result 

begin 

Result ;= Is_Eirpty(The_Queue) ; 
end Is^Enpty; 


procedure Is^En^ty 


in Queue; 
in Queue; 
out Boolean) is 


in Queue; 
out Nat-ural) is 


in Queue; 

out Boolean) is 


procedure Front^Of (The^Queue : in Queue; 

Result : Item) is 

begin 

Result Front_Of(The_Queue); 

end Front_0f; 

procedure Position_0f (The_Item : in Item; 

In«The_Queue ; in Queue; 

Result : out Natural) is 

^^^Result Position^Of(The_Item,In_The_Queue); 

end Position^Of; 
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end of modification 

function Is_E( 3 ual (Left : in Queue; 

Right : in Queue) return Boolean is 
Left_Index : Structure := Left.The_Front; 

Right_Index : Structure := Right.The_Front; 
begin 

while Left_Index /is null loop 

if Left„Index.The_Itein /= Right_Index.The_Item then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_Index ;= Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length^Of (The_Queue : in Queue) return Natural is 
Comt : Natural := 0; 

Index : Structure := The_Queue.The_Front; 
begin 

while Index /= null loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Length__0f; 

function Is_Enpty (The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = null); 
end Is_Enpty; 


function Front_Of (The^CJueue : in Queue) return Item is 
begin 

return The_Queue.The_Front.The_Item; 
exception 

when Cons traint_Err or s:> 
raise Underflow; 
end Front_Of; 

function Position_Of (The_Item : in Item; 

In_The_jQueue ; in Queue) return Natural is 
Position ; Natural ;= 1; 

Index : Structure := In..The_Queue.The_Front; 
begin 

while Index /= null loop 

if Index, The_Item = The_Item then 
return Position; 

else 

Position := Position + 1; 

Index ;= Index,Next; 
end if; 
end loop; 
return 0; 
end Position_Of; 

procedure Iterate (Over__The__Queue ; in Queue) is 

The^Iterator : Structure := Over_The_Queue.The^Front; 
Continue : Boolean; 
begin 

while not (Ihe^Iterator == null) loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The__Iterator :=: The_Iterator.Next; 
end loop; 
end Iterate; 

end Queue_Priori ty_Balking_Sequential_UnboundedUManaged_I tera tor; 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

PSDL 


TYPE Queue_PriorityL.Balking_Seguential_Unbounded_Managed_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

Priority : PRIVATE_TYPE, 

Priority_0£ : FUNCTION[The_Itern : Item, RETURN : Priority], 
func_"<-“ : FIMCTIONfLeft : Priority, Right : Priority, RETURN : 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

Fror\_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

From_The_Queue : Queue, 

At_The_Position : Positive 
OUTPUT 

From_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 


Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Enpty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Position_Of 

SPECIFICATION 

INPUT 

The_Item : Item, 

In^The_Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : inIt : Item], Continue ; 

Boolean]] 

INPUT 

Over_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue„Priority_Balking_Sequential_Unbounded_Managed_Iterator 

END 


Out[t : 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function Priority_Of {The_Item : in Item) return 

Priority; 

with function "<=“ {Left : in Priority; 

Right : in Priority) return Boolean; 

package 

Queue_Priority_Balking_Sequential_UnboundedLUninanagedJNoniterator is 
type Queue is limited private; 


procedure Copy 

{Froict.The_Queue 

: in 

Queue; 


To_The_Queue 

; in out 

Queue); 

procedure Clear 

{The^Queue 

: in out 

Queue); 

procedure Add 

{The^Item 

: in 

Item; 


To_The_Queue 

: in out 

Queue); 

procedure Pop 

(The_Queue 

; in out 

Queue); 

procedure Remove_Item 

(FronuThe_Queue 

; in out 

Queue; 


At_The_Position : in 

Positive; 

modified by Tuan Nguyen 
replacing functions with procedures 



procedure ls_Egual 

{Left : 

in {Jueue; 



Right : 

in Queue; 



Result : 

out Boolean); 

procedure Length_Of 

{The^Queue 

in Queue; 



Result ; 

out Natural); 

procedure Is^Enpty 

{The^Queue ; 

in Queue; 




Result 

: out Boolean); 


procedure Front_Of 

(The_Queue 

Result 

: in Queue; 

: Item) ; 


procedure PositionjOf 

{The_Item 

ItL,The_Queue 

Result 

; in I tern; 

: in Queue; 

: out Natural); 


end of modification 

function Is_Equal 

{Left 

in Queue; 



Right : 

in Queue) return 

Boolean 

function Length^Of 

(The_Queue : 

in Queue) return 

Natural 

function Is_Errpty 

(The_Queue ; 

in Queue) return 

Boolean 

function Front_Of 

(The^Queue : 

in (Jnetie) return 

Item; 

function Position_Of 

(The_Item : 

in Item; 



In_The_Queue : 

in Queue) return 

Natural; 


Overflow ; exception; 
Underflow : exception; 
Position_Error ; exception; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : Structure; 
end record; 

end Queue_Priority_Balking_Sequential_Unboiinded_UnmanagecLNoniterator 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

■Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in sxibdivision (b) (3) {ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 s. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874) 

package body 

Queue_Pr ior i ty_Ba lking_Sequen t i al_Unbounded_Unmanaged_JJon 1 ter a tor 

is 


type Node is 
record 

The_Item : Item; 

Next : Structure; 

end record; 


procedure Copy (From„The_Queue : in Queue; 

To_The_,Queue : in out Queue) is 
Froituindex : Structure :>= FroiiuThe_Queue.The_Front; 
To_Index : Structure; 
begin 

if FroituThe_Queue. The_Front ® null then 
To_The_Queue.The_Front null; 

To__The_,Queue. The_Back : ^ null ; 


else 

To_The_Queue.The^Front := 

new Node' (The_Item => FronL.Index.The_Item, 

Next => null); 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
To_Index := To_The_Queue.The_Front; 

Frott\_Index := From_Index. Next; 
while From_Index /= null loop 

To_Index.Next := new Node' (The_Itern => 
From_Index. The__Item, 

Next => null); 


To_Index := To_Index.Next; 
From_Index := From_Index.Next; 
To_The_Queue.The_Back := To_Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue ;= Queue'(The_Front => null, 
The_Back => null); 

end Clear; 


procedure Add (The_Item : in Item; 

To_'lh.e_Queue : in out Queue) is 
Previous : Structure; 

Index : Structure To_The_Queue.The_Front; 

begin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front := new Node ' {The_Itern => The_Item, 

Next => null); 

To_The_Queue. The_Back : = To_The_Queue. The_Front; 

else 

while (Index /= null) and then 
(Priority_Of{The_Item) <= 

Priority_Of(Index.The_Itern)) loop 
Previous Index; 

Index := Index.Next; 
end loop; 

if Previous = null then 

To_'Ihe_Queue. The_Front : = 

new Node'(The^Item => The_Item, 

Next => Index); 

if To_The_Queue.The_Back = null then 

Tojrhe_Queue. The__Back : = To_The_Queue. The_Fron t; 
end if; 

elsif Index = null then 

To_The_Queue.The_Back.Next := new Node' {The_Itern => 

Next => 

To_The_Queue.The_Back := To_The_Queue.The_Back.Next ; 

else 

Previous .Next := new Node * (The_Itern => The_ltem, 

Next => Index); 

end if; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 


The_Item, 
null); 


procedure Pop {The_Queue ; in out Queue) is 
begin 

The_Queue. The_Front : = The_Queue. The_Front. Next ; 
if The_Queue.The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when Constraint_Error ==> 
raise Underflow; 

end Pop; 

procedure Remove_Item {From_The_Queue : in out Queue; 

At_The_Position : in Positive) is 
Coiint : Natural 1; 

Previous : Structure; 

Index ; Structure := From_Tbe_Queue .The_Front; 
begin 

while Index /= null loop 

if Count = At_The_Position then 
exit; 

else 

Count := Count + 1; 

Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

if Index = null then 

raise Position_Error; 
elsif Previous = null then 

From_The_Queue, The_Front ; = Index. Next ; 

else 

Previous.Next := Index.Next; 
end if; 

if FroiruThe_Qu€ue -The_Back = Index then 
From_The_Queue.The_Back := Previous; 
end if; 

end R€move_Item; 

modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_Equal (Left : 

Right ; 

Result : 

begin 

Result := Is_Egual(Left,Right); 
end Is_Equal; 

procedure Length_0f (The_Queue : 

Result : 

begin 

Result ;= Length_0f(The_Queue); 
end Length_Of; 

procedure Is_En?)ty (The_Queue : 

Result ; 

begin 

Result := Is_Einpty (The_Queue) ; 
end Is_Empty; 

procedure Front_0f (The_Queue : 

Result : 

begin 

Result := Front_Of(The_Queue); 
end Front_0f; 

procedure Position_0f (The_Item : 

In_The_Queue ; 

Result : 

begin 

Result : Position_Of (The_Item, In_The_Queue); 
end Position_Of; 

end of modification 

function Is_Egual (Left : in Queue; 

Right : in Queue) return Boolean is 
Left_Index : Structure := Left.The_Front; 

Right_lndex : Structure := Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index.The_Item /= Right_Index,The_Item then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_lndex := Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length^Of (The_Queue : in Queue) return Natural is 
Covint : Natural := 0; 

Index ; Structure := The_Queue.The_Front; 
begin 


in Queue; 
in Queue; 
out Boolean) is 


in Queue; 

out Natural) is* 


in Queue; 

out Boolean) is 


in Queue; 
Item) is 


in Item; 

in Queue; 

out Natural) is 
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while Index /= null loop 
Count := Count + 1; 

Index :* Index.Next; 
end loop; 
return Count; 
end Length>.Of; 

fVinetion Is_Ei)npty (The_Queue : in Queue) 
begin 

return (The_Queue.The_Front = null); 
end Is_Ertpty; 

function Front_Of (The_Queue : in Queue) 
begin 

return The_Queue.The_Front. The^Itern; 
exception 

when Constraint^Error => 
raise Underflow; 
end Front_Of; 


return Boolean is 


return Item is 


fvinction Position_Of {The_Item ; in Item; 

In_The_Queue : in Queue) return Natural is 
Position : Natural := 1; 

Index : Structure := ln_'Ihe_Queue.The_Front; 
begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 
return Position; 

else 

Position ;= Position + 1; 

Index := Index.Next; 
end if; 
end loop; 
return 0; 
end Position„Of; 

end Queue_Pr iori ty_Balking_Sequential_Unbounded_Unmanaged_Noni terator; 
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QUEUE PRIORITY BALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 


PSDL 


TYPE Queue priority__Balking_Sequential_Uiibounde(i_UnmanagecLJJoniterator 
SPECIFICATION 
GENERIC 

Item ; PRIVATE^TYPE, 

Priority : PRIVATE_TyPE, 

Priority_Of ; FUNCTION [The_Itern : Item, RETURN : Priority], 

: FUNCTION [Left : Priority, Right : Priority, RETURN : 

Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Queue : Queue, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Queue : Queue 
OUTPUT 

The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Remove_Item 
SPECIFICATION 
INPUT 

FronL.The_Queue : Queue, 

At_'nie_Position : Positive 
OUTPUT 

ProirL_The_Queue : Queue 
EXCEPTIONS 


Overflow, Underflow, Position_Error 

END 

OPERATOR IS_Equal 

SPECIFICATION 

INPUT 

Left : Queue, 

Right : Queue 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Underflow, Position^Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The__Queue : Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Is_Ert?)ty 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Front_Of 

SPECIFICATION 

INPUT 

The_Queue ; Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

OPERATOR Position_Of 

SPECIFICATION 

INPUT 

The_Item ; Item, 

In_The_Queue ; Queue 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Position_Error 

END 

END 

IMPLEMENTATION ADA 

Queue_Pr i or i ty_Bal king_Sequen t ial_Unbounded_UnmanagedJloni ter a t or 

END 
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QUEUE PBIORITYNONBALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Priority is limited private; 

with function Priority_Of (The_Item : in Item) return 
Priority; 

with function "<=" (Left : in Priority; 

Right : in Priority) return Boolean; 

package 

Queue_Pr ior i ty_?Johba lking_Sec3uent ial_UnboundecL.UninanagedJNoni t er a tor 

is 


type Queue is limited private; 


procedure Copy (From_The_Queue ; in Queue; 

To_The_Queue ; in out Queue); 
procedure Clear (The_Queue ; in out Queue); 

procedure Add (The_Item : in Itern; 

To_The_Queue : in out Queue); 
procedure Pop (The_Queue : in out Queue); 

— modified by Tuan Nguyen 

replacing fxinctions with procedures 


procedure Is_Equal 
procedure Length-Of 


(Left 

Right 

Result 

(The_Queue 


in Queue; 
in Queue; 
out Boolean); 
in Queue; 


Result 

procedure Is^Empty {The_Queue 

Result 

procedure Front_Of {The_Queue 

Result 


end of modification 


out Natural); 
in Queue; 
out Boolean); 
in Queue; 
Item) ; 


fline t ion Is^Equal (Left 
Right 

function Length_Of (The_Queue 
function Is^Enpty (The_Queue 
function Front_Of (The_Queue 


in Queue; 
in Queue) 
in Queue) 
in Queue) 
in Queue) 


return Boolean; 
return Natural; 
return Boolean; 
return Item; 


Overflow : exception; 
Underflow ; exception; 


private 

type Node; 

type Structure is access Node; 
type Queue is 
record 

The_Front : Structure; 

The_Back : Structure; 
end record; 

end 

Queue_Priori ty_Nonbalking_Sequential_Unbounded_UnmanagedJKoni terator 
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QUEUE PRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 


end if; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 


"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in sxibdivision (b) (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package body ^ • 

Queue_Pr ior i ty^Nonba lking_Seguent ial_Unboujide<3LtJnmanaged_Noni ter a t or 


type Node is 
record 

The_Item ; Item; 

Next : Structure; 
end record; 


procedure Copy (FronL_The_Queue : in Queue; 

To_The_Queue : in out Queue) is 
Fron\_Index : Structure := FrorcL.The_Queue.The_Front; 
To_Index ; Structure; 
begin 

if FrorruThe_Queue.The_Front » null then 
To_The_Queue.The_Front null; 

To_The_Queue•The_Back := null; 

else 


To_The_Queue.The_Front := 

new Node' (The_Item => FroiiuIndex.The_Item, 

Next => null); 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
To_lndex := Tojrhe_Queue.The_Front; 

Fro^^_Index := Fron\_Index.Next; 
while FrorruXndex /- null loop 

To_Index.Next := new Node’ {The_Item => 
From_Index. The^I tem. 

Next => null); 


To^Index ;= To_Index.Next; 
Fronulndex := Froitv_Index.Next; 
To_The_Queue.The_Back := To^Index; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Queue : in out Queue) is 
begin 

The_Queue := Queue’{The_Front => null, 
The_Back => null); 

end Clear; 


procedure Add (The_Item : in Item; 

To_The_Queue : in out Queue) is 
Previous : Structure; 

Index : Structure := To_The_Queue.The_Front; 
begin 

if To_The_Queue.The_Front = null then 

To_The_Queue.The_Front new Node’(Thc_Itern => The_Itein, 

Next => null); 

To_The_Queue.The_Back := To_’rhe_Queue.The_Front; 

else 

while (Index /= null) eind then 
(Priority_Of(The_Item) <= 

Priority_Of (Index, The_Itern)) loop 
Previous := Index; 

Index : = Index. Next; 
end loop; 

if Previous = null then 

To_The_Queue. The^Front : = 

new Node’ (The^Item => The_Itein, 

Next -> Index); 
if To_The_Queue. The_Back = null then 

To_The_Queue.The_Back := To_The_Queue.The_Front; 
end if; 

elsif Index = null then 

To_The_Queue.The_Back.Next := new Node* (The_Itein => 


The_Item, 


Next => 


null); 


To_The_Queue.The_Back := To_The_Queue.The_Baek.Next; 

Previous .Next := new Node* (The_Itein => The_Item, 
Next => Index); 


end if; 


procedure Pop (The_Queue : in out Queue) is 
begin 

The_Queue.The_Front := The_Queue.The_Front.Next; 
if The_Queue.The_Front = null then 
The_Queue.The_Back := null; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 


— modified by Tuan Nguyen 

— replacing functions with procedures 


procedure Is_Equal (Left : in Queue; 

Right : in Queue; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 


procedure Length^Of (The_Queue 
Result 

begin 

Result Length_Of(The_Queue); 
end Length_0f; 

procedure Is_Empty (The_Queue 

Result 

begin 

Result :- Is_Enpty(The_Queue); 
end Is_Eirpty; 

procedure Front_Of (The_Queue 

Result 

begin 

Result := Front_Of(The_Queue); 
end Front_Of; 


in Queue; 
out Natural) is 


in Queue; 

out Boolean) is 


in Queue; 
Item) is 


— end of modification 

fxjnction Is_E< 3 ual (Left : in Queue; 

Right ; in Queue) return Boolean is 
Left_Index : Structure := Left.The_Front; 

Right_Index : Structure := Right.The_Front; 
begin 

while Left_Index /= null loop 

if Left_Index.The_Item /= Right_Index.The_Item then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_Index ;= Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = null) ; 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

function Length_0f (The_Queue ; in Queue) return Natural is 
Count : Natural := 0; 

Index : Structure ;= The_Queue.The_Front; 
begin 

while Index /= null loop 
Count := Count + 1; 
index := Index.Next; 
end loop; 
return Count; 
end Length_Of; 

fxinction Is_Eirpty (The_Queue : in Queue) return Boolean is 
begin 

return (The_Queue.The_Front = null); 
end Is_Eit 5 >ty; 

function Front_0f (The_Queue : in Queue) return Item is 
begin 

return The_Queue.The_Pront. The_Item; 
exception 

when Constraint_Error «> 
raise Underflow; 
end Front_0f; 


Queue_Pr ior i ty_Nonbalking_Sequent i al_Unbounded_Unmanaged_Noni tera tor 
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QUEUE PRIORITY NONBALKING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

PSDL 


TYPE 

Queue_Pr ior i tyJNonbalking_Sequen t i al_Unbounded_UnmanagedLNon i ter a tor 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

Priority : PRIVATE_TYPE, 

Priority_Of : FUNCTION[The^Item : Item, RETURN : Priority], 
func_'’<=" : FUNCTION[Left : Priority, Right : Priority, RETURN : 
Boolean] 

OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuThe_Queue : Queue, 

To_The_Queue ; Queue 
OUTPUT 

To_The_Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Queue ; Queue 
OUTPUT 

The^Queue : Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Queue : Queue 
OUTPUT 

To_The_Queue ; Queue 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The^Queue : Queue 
OUTPUT 

The_Queue : Queue 
EXCEPTIONS 


Overflow, Underflow 

END 

OPERATOR Is_Egual 

SPECIFICATION 

INPUT 

Left : Queue, 

Right : Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_Queue : Queue 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_En 5 >ty 

SPECIFICATION 

INPUT 

The_Queue ; Queue 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Front^Of 

SPECIFICATION 

INPUT 

The_Queue ; Queue, 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Queue_„Priority_Nonbalking_Sequential„Unbo\anded_UnmanagedLNoniterator 

END 
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RING SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

package Ring_Sequential_BoundecL>lanaged^Iterator is 

type Ring(The_Size : Positive) is limited private; 
type Direction is (Forward, Backward); 


procedure Copy 
Ring; 

Ring) ; 

procedure Clear 
Ring); 

procedure Insert 
I tern; 

Ring); 

procedure Pop 
Ring); 

procedure Rotate 
Ring ; 

Direction); 

procedure Mark 
Ring); 

procedure Rotate_To_Mark 
Ring); 

— modified by Tuan Nguyen 

— 10 Jeinuary 1996 

— adding procedures to rep! 


(From_The_Ring 

in 


To_The_Ring 

in 

out 

(The_Ring 

in 

out 

{The_Item 

in 


Iru.The_Ring 

in 

out 

{The_Ring 

in 

out 

{The_Ring 

in 

out 

In_The_Direction 

in 


{The_Ring 

in 

out 

(The_Ring 

in 

out 


functions 


procedure Is_Equal (Left : in Ring; 

Right : in Ring; 

Result : out Boolean); 

procedure Extent^Of (The_Ring : in Ring; 

Result : out Natural); 

procedure Is_Eiipty (The_Ring : in Ring; 

Result : out Boolean) ; 


procedure Top_Of (The_Ring : in Ring; 

Result : out Item); 
procedure At_Mark (The_Ring : in Ring; 

Result : out Boolean); 

— end of modification 

function Is_Equal (Left : in Ring; 

Right : in Ring) return 

Booleami; 

function Extent_Of (The_Ring : in Ring) return 
Natural; 

function Is_Empty (The_Ring : in Ring) return 
Boolean; 

function Top_Of (The_Ring : in Ring) return 
I tern; 

function At_Mark (The_Ring ; in Ring) return 
Boolean; 

generic 

with procedure Process (The_Item : in Itern; 

Continue : out 

Boolean); 

procedure Iterate (Over_The_Ring : in Ring); 

Overflow : exception; 

Underflow : exception; 

Rotate_Error : exception; 

private 

type Items is array(Positive range <>) of Item; 
type Ring{The_Size : Positive) is 
record 

The^Top : Natural := 0; 

The_Back : Natural := 0; 

The_Mark : Natural := 0; 

The_Items : Items (1 .. The^Size); 

end record; 

end Ring_Sequential_BoundecLManaged_Iterator; 
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RING SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

— "Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data cuid Conputer 

— Software Clause of FAR 52.227~7013. Mcuiufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Ring_Sequential_BoundecLManaged_Iterator 
is 

procedure Copy (FronuThe^Ring : in Ring; 

To_The_Ring : in out Ring) is 

begin 

if From_The_Ring.The_Back > 
To_The_Ring.The_Size then 

raise Overflow; 

elsif Fron\_The_Ring. The^Back = 0 then 
To_The_Ring.The_Top := 0; 

To_The_Ring. The_Back ;= 0; 

To_The_Ring.TheJMark := 0; 

else 

To_The_Ring.The_Iterns(1 ♦. 
Froiiu.The_Jling.The_Back) : = 

FronuThe_Ring. The_I terns (1 .. 
Froin_The_Ring.The_Back); 

To_The_Ring.The_Top ;= 

Fr oin_The_Ring. The_Top; 

To_The_Ring.The_Back := 

Froir\_The_Ring. The^Back ; 

To_The_Ring.The_Nark := 

Frorru'Kie^Ring. TheJMark; 
end if; 
end Copy; 

procedure Clear (The_Ring : in out Ring) is 
begin 

The_Ring.The_Top ;= 0; 

The_Ring.The_Back := 0; 

The_Ring.The_Mark := 0; 
end Clear; 


if The_Ring. The_Top = The_Ring - The Jlark 

then 

The_Ring.The^ark := 1; 
end if; 

'nie_Ring. The_Top := 1; 

else 

if The_Ring. TheJWark > The_Ring. The_Top 

then 

The_Ring,The^Mark := 

The_Ring. The JMark - 1; 

end if; 
end if; 
end if; 
end Pop; 

procedure Rotate (The_,Ring : in out Ring; 

In_The_Direction ; in 

Direction) is 
begin 

if The_Ring.The_Back = 0 then 
raise Rotate_Error; 
elsif In_The_Direction = Forward then 

The_Ring.The_Top := Th€_Ring.The_Top + 1; 
if The_Ring.The_Top > The^Ring.The_Back 

then 

The_Ring.The^Top := 1; 
end if; 

else 

The_Ring.The_Top The^Ring.The_Top - 1; 
if The_Ring.The_Top = 0 then 

TheJRing. The_Top : = The_Ring. The_Back; 
end if; 
end if; 
end Rotate; 

procedure Mark (The_Ring : in out Ring) is 
begin 

The_Ring.The_Mark := The^Ring,The_Top; 
end Mark; 

procedure Rotate_To_Mark (The_Ring : in out Ring) 
is 

begin 

The_Ring. The_Top := The_Ring. The_Mark; 
end Rotate_To_Mark; 

— modified by Tuan Nguyen 

— 10 January 1996 

— adding procedures to replace functions 


procedure Insert (The_Itein : in I tern; 

In_TheJRing : in out Ring) is 

begin 

if In_The_Ring,TheJBack =: In_The_Ring.The_Size 

then 

raise Overflow; 

elsif In_The_Ring.The_Back = 0 then 
In_The_Ring.The_Top := 1; 

In_The_Ring.The_Back ;= 1; 

In^The_Ring, The_^rk := 1; 

In_The_Ring. The_I terns (1) ; = The_I tern; 

else 

In^The__Ring. The_I teins 

((In_The_Ring.The_Top +1) 

(InJTheJRing. The_Back + 1)) : = 

In_The_Ring. The_I terns (In_The_Ring. TheJTop 


In_The_Ring.The„Back) ,- 

In_The_Ring. The_I terns (In_The_Ring. The_Top) 

:= The_Item; 

In_The_Ring. The_Back : = 

In_The_Ring.The_Back + 1; 

if In_The_Ring.The_Mark >= 

In_The_Ring. The_Top then 

In_The_Ring. The_Mark : = 

In_The_Ring. The JMark + 1; 
end if; 
end if; 
end Insert; 


procedure Is_Equal (Left : in Ring; 

Right : in Ring; 

Result ; out Boolean) is 

begin 

Result ;= Is_Equal(Left,Right); 
end Is_Egual; 

procedure Extent_Of (The_Ring : in Ring; 

Result ; out Natural) is 

begin 

Result := Extent_Of{The_Ring); 
end Extent_Of; 

procedure Is_Enpty (The_Ring : in Ring; 

Result : out Boolean) is 

begin 

Result := Is_Enpty(The_Ring); 
end Is_Eirpty; 

procedure Top_Of (The_Ring : in Ring; 

Result : out Item) is 

begin 

Result := Top_0f(The_Ring); 
end Top_Of; 

procedure At JMark (The_Ring ; in Ring; 

Result : out Boolean) is 

begin 

Result := At_Mark(The^Ring); 
end At_Mark; 


procedure Pop(The_Ring : in out Ring) is 
begin 

if The_Ring.The_^ack = 0 then 
raise Underflow; 

elsif The_Ring.The_Back = 1 then 
The_Ring.The_Top := 0; 

The_Ring.The_Back := 0; 

The_Ring. The JMark := 0; 

else 

The^Ring. The_I terns (The_Ring. The_,Top .. 
(The_Ring.The_Back - 1)) := 

The_Ring. The_I terns ({The_Ring. The_Top + 1) 
.. The_Ring.The_Back); 

The_Ring.The_Back := The_Ring.The_Back - 1; 
if TheJR.ing.The_Top > The_Ring.The_Back 

then 


— end of modification 

function Is_Equal (Left : in Ring; 

Right : in Ring) return Boolean 
is 

Left^Index : Natural := Left.The_Top; 

Right_Index : Natural := Right. The_Top; 
begin 

if Left.The_Back /= Right.The^Back then 
return False; 

elsif Left.The_Items(Left_Index) /= 

Right.The_Iterns(Right_Index) then 
return False; 

elsif (Left.Thejlark = Left_Index) and then 
(Right.The_Mark /= Right_Index) then 
return False; 

else 
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Left_Index := Left_Index + 1; 
if Left_Index > Lef t .Th.e_Back then 
Left_Index 1; 
end if; 

Right_Index := Right_Index + 1; 
if Right_Index > Right.The_Back then 
Right_lndex := 1; 
end if; 

while Left^lndex /= Left.The_Top loop 
if Left.The_Iteins(Left_Index) /= 

Right.The_Items(Right_Index) then 
return False; 

elsif (Left.TheJlark = Left^Index) and 


then 

then 


{Right.The^Mark /= Right^Index) 
return False; 

else 

Left_Index Left_Index + 1; 
if Left^Index > Left.The_Back then 
Left^Index := 1; 
end if; 

Right^Index := Right_Index + 1; 
if Right_Index > Right.The_Back 


then 


Right_Index := 1; 
end if; 
end if; 
end loop; 

return (Right_Index = Right.The_Top); 


end if; 
exception 

when Constraint^Error => 

return (Left.The_Top = Right.The_Top); 
end Is_Equal; 


function Extent^Of {The_Ring : in Ring) return 
Natural is 
begin 

return The_Ring-The_Back; 
end Extent^Of; 


function Is_Enpty (The_Ring ; in Ring) return 
Boolean is 
begin 

return (The_Ring.The_Back = 0); 
end Is^Enpty; 

function Top_Of (The^Ring : in Ring) return Item is 
begin 

return The^Ring. The^Items (The_Ring.The_Top) ; 
exception 

when Constraint^Error => 
raise Underflow; 
end Top_Of; 

function At_Mark (The^Ring : in Ring) return 
Boolean is 
begin 

return (The_Ring,The_Top = The_Ring.The_Mark) ; 
end At_Na3Ck; 

procedure Iterate (Over_The_Ring : in Ring) is 
Continue : Boolean := True; 
begin 

for The_Iterator in Over_The_Ring.The_Top .. 

Over_The_Ring,The_Back loop 

Process {Over_The_Ring.The_Iterns (The_Iterator), 

Continue); 

exit when not Continue; 
end loop; 
if Continue then 

for The_Iterator in 1 .. 

Over_The_Ring.The_Top - 1 loop 

Process (Over_The_Ring.The_Iterns (The_Iterator), 

Continue); 

exit when not Continue; 
end loop; 
end if; 
end Iterate; 

end Ring_Se< 3 uential_Bounded_Ilanaged_Iterator; 
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RING SEQUENTIAL BOUNDED MANAGED ITERATOR 

PSDL 


TYPE Ring__Sequential_BoundedJIanagec3_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuThe^Ring : Ring, 

To_The_Ring : Ring 
OUTPUT 

To_The_Ring ; Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The^Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The^Item : Item, 

In__The_Ring : Ring 
OUTPUT 

In_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_,Ring : Ring 
OUTPUT 

The^Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate 
SPECIFICATION 
INPUT 

The_Ring : Ring, 

In_The_Direction ; Direction 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Mark 
SPECIFICATION 
INPUT 

The_Ring ; Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate_To_Mark 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 


The^Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR IS^Equal 

SPECIFICATION 

INPUT 

Left : Ring, 

Right ; Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Is_Eit?3ty 

SPECIFICATION 

INPUT 

The_Ring ; Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

Ihe^Ring : Ring 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR At_Mark 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE [The_Itern : in[t : Item] 
Continue : out It : Boolean]] 

INPUT 

Over_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

END 

IMPLEMENTATION ADA 

Ring_Secjuential_BoundedLManaged^Iterator 

END 
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RING SEQUENTIAL BOUNDED MANAGED NONITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

package Ring_Sequential_Bounded^anaged_Noniterator is 


type Ring{The_Size ; Positive) is limited private; 


type Direction is (Forward, Backward) ; 


procedure 

Ring; 

Ring) ; 

procedure 
Ring) ; 

procedure 

Item; 

Ring) ; 

procedure 
Ring); 

procedure 

Ring; 

Direction); 

procedure 
Ring); 

procedure 
Ring); 


Copy 

(Fr om_The_Ring 

in 


To_The_Ring 

in out 

Clear 

(The_Ring 

in out 

Insert 

(The_Item 

in 


In_The_Ring 

in out 

Pop 

(The_Ring 

in out 

Rotate 

(The_Ring 

in out 


In_The_Direc tion 

in 

Mark 

(The_Ring 

in out 

Rotate_To_JIark 

(The_Ring 

in out 


function Is_Equal 
Boolean; 

function Extent_Of 
Natural; 

function Is^Empty 
Boolean; 

function Top_Of 
Item; 

function Atjlark 
Boolean; 


(Left 

1 in Ring; 


Right 

; in Ring) 

return 

(The_Ring ; 

; in Ring) 

return 

(The_Ring ; 

1 in Ring) 

return 

(The_Ring : 

; in Ring) 

return 

(The_Ring j 

; in Ring) 

return 


Overflow : exception; 
Underflow ; exception; 
Rotate_Error ; exception; 


private 

type Items is array(Positive range <>} of Itern; 
type Ring(The_Siz€ : Positive) is 
record 

The_Top ; Natural := 0; 

The_Back ; Natural ;= 0; 

TheJIark : Natural := 0; 

The_Items : Items(1 .. The^Size); 

end record; 

end Ring_Sequential_Bounded^Jlanaged_Noniterator; 
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RING SEQUENTIAL BOUNDED MANAGED NONITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

“Restricted Rights Legend" 

— Use, duplication, or disclosure is s\jbject to 

— restrictions as set forth in stibdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package body 

Ring_Sequent ial_Bounded_ManagedJJon iterator is 

procedure Copy (FronuThe_Ring : in Ring; 

To_The_Ring : in out Ring) is 

begin 

if Froin_The_Ring. The_Back > 
To_T:he_Ring.The_Size then 
raise Overflow; 

elsif FronL_The_Ring. The_Back = 0 then 
To_The_Ring. The^Top := 0; 

To_The_Ring.The_Back ;= 0; 
To_The_Ring.The_Mark := 0; 

else 

To_The_Ring. The_I terns (1 .. 

Fron\_The_Ring. The^Back) : = 

Froit\_The_Ring. The_I terns (1 ., 
FronL,The_Ring. The^Back); 

To_The_Ring. The_Top : = 

FroiiuThe_Ring. The_Top ; 

To_The_Ring. The_Back : = 

FronuTlie—Ring. The_Back ; 

To_The_Ring. The^Mark : = 

Frorn_The_Ring. The.^rk ; 
end if; 
end Copy; 

procedure Clear (The_Ring ; in out Ring) is 
begin 

The_Ring. The_Top ; = 0; 

The_Ring.The_Back := 0; 

The_Ring.The_Mark := 0; 
end Clear; 


if The_Ring.ThejTop « The_Ring.The_Mark 

then 

The_Ring.The_Mark := 1; 
end if; 

The_Ring.The_Top := 1; 

else 

if The_Ring-The_Mark > The^Ring.TheJTop 

then 

The_Ring.TheJlark ; = 

The_Ring.The_Mark - 1; 

end if; 
end if; 
end if; 
end Pop; 

procedure Rotate (The_Ring : in out Ring; 

In_The_Direction : in 

Direction) is 
begin 

if The_Ring.The_Back = 0 then 
raise Rotate_Error; 
elsif InJThe^Direction = Forward then 

The_Ring. The_Top := The_Ring. The_Top + 1; 
if The_Ring.The_Top > The_Ring.The_Back 

then 

The_Ring.The_Top := 1; 
end if; 

else 

The_Ring, The_Top := The_Ring. The_Top - 1; 
if The_Ring.The_Top = 0 then 

The_Ring.The_Top ;= The^Ring.The_Back; 
end if; 
end if; 
end Rotate; 

procedure Mark (The^Ring : in out Ring) is 
begin 

The_Ring.TheJMark ;= The_Ring.The_Top; 
end Mark; 

procedure Rotate_To_Mark ('Ihe_Ring : in out Ring) 
is 

begin 

TheJRing. The^Top : = The_Ring. The^Mark ; 
end Rotate_To_Jlark; 

— modified by Tuan Nguyen 

— 10 January 1996 

— adding procedures to replace functions 


procedure Insert {The_Item ; in Item; 

In_The_Ring : in out Ring) is 

begin 

if In_The„Ring.The_Back = In_The_Ring.The_Size 

then 

raise Overflow; 

elsif In_The_Ring.The_Back = 0 then 
Iii_The_Ring. The_Top : = 1; 

In^The_Ring.The_Back ;= 1; 

In_The_Ring, The_.Mark := 1; 

In_The_Ring. The_I terns (1) : = The_I t em ; 

else 

In_The__Ring. The_I terns 

((In_The_Ring.The_Top + 1) .. 

(In_The_Ring. 'Ihe_Back + 1)} : = 

In^The_Ring. The_I terns {In_The_Ring, The_Top 


In^The_Ring.The_Back); 

In_The_Ring. The_I terns (In_The_Ring. The_Top) 

:= The_Item; 

In_The_Ring.The_Back ;= 
InL_The_Ring.The__Back + 1; 

if In_The_Ring.TheJ3ark >= 
ln^The_Ring.The_Top then 

In_The_Ring. The_Mark : = 
In_The_Ring.The_Mark + 1; 
end if; 
end if; 
end Insert; 


procedure Is_Equal (Left : in Ring; 

Right : in Ring; 

Result : out Boolean) is 

begin 

Result := Is_Equal(Left,Right); 
end Is_E< 3 ual; 

procedure Extent_Of (The_Ring : in Ring; 

Result : out Natural) is 

begin 

Result Extent_Of(The^Ring); 
end Extent^Of; 

procedure Is_Qr?>ty (The_Ring : in Ring; 

Result : out Boolean) is 

begin 

Result : = Is^Eir?)ty(The_Ring) ; 
end Is_Eiqpty; 

procedure Top_Of (The_Ring : in Ring; 

Result ; out Item) is 

begin 

Result := Top_Of(The^Ring); 
end Top_Of; 

procedure AtJMark (The_Ring : in Ring; 

Result : out Boolean) is 

begin 

Result := At_Mark{The_Ring); 
end AtJIark; 


procedure Pop(The_Ring : in out Ring) is 
begin 

if The_Ring.The_Back = 0 then 
raise Underflow; 

elsif The_Ring.The_Back = 1 then 
The_Ring.The_Top ;= 0; 

The_Ring. The_Back : = 0; 

The_Ring.The_^Mark := 0; 

else 

The_Ring. The_I terns {The_Ring. The_Top .. 
(The_Ring.The_Back - 1)) ;= 

The_Ring. The_I terns ((The_Ring. The_Top + 1) 
.. The_Ring.The_Back); 

The_Ring.TheJBack := The_Ring.The_Back - 1; 
if Theming.The_Top > The_Ring.The^Back 

then 


— end of modification 

function Is_Equal (Left : in Ring; 

Right : in Ring) return Boolean 
is 

Left_Index ; Natural := Left.The_Top; 

Right_Index : Natural := Right.The_Top; 
begin 

if Left.The_Back /= Right.The^Back then 
return False; 

elsif Left.The_Iterns(Left_Index) /= 

Right.The_Iterns(Right_Index) then 
return False; 

elsif (Left.The_Mark = Left_Index) and then 
(Right.The_Mark /= Right^Index) then 
return False; 

else 
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Left_Index := Left_Index + 1; 
if Left_lndex > Left.The^Back then 
Left_Index := 1; 
end if; 

Right_Index := Right^Index + 1; 
if Right_Index > Right.The^Back then 
Right_Index := 1; 
end if; 

while Left^Index /= Left.The^Top loop 
if Left.The_Iteins(Left_Index) 

Right.The_Iterns(Right_lndex) then 
return False; 

elsif (Left.The^Mark = Left_Index) and 
then . , , 

(Right.The_Mark /= Right_Index) 

then 

return False; 

else 

Left_Index ;= Left_Index + 1; 
if Left_Index > Left.The^Back then 
Left_Index ;= 1; 
end if; 

Right_Index := Right_Index + 1; 
if Right_Index > Right.The_Back 

then 

Right_Index := 1; 
end if; 
end if; 
end loop; 

return {Right_Index = Right *The^Top}; 
end if; 
exception 


when Constraint_Error => 

return (Left.The^Top = Right.The^Top); 
end Is_Equal; 

function Extent_Of (The_Ring : in Ring) return 
Natural is 
begin 

return The_Ring.The_Back; 
end Extent_Of; 


function Is_En?)ty (The_Ring : in Ring) return 
Boolean is 
begin 

return (The_Ring.The_Back = 0); 
end Is_Btrpty; 

ftinction Top_0f (The_Ring : in Ring) return Item is 
begin 

return The_Ring.The_Iteins (The_Ring.The_Top) ; 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_0f; 


fvmction AtJIark {The_Ring : in Ring) return 
Boolean is 
begin 

return {The_Ring - The_Top = The_Ring. The_Kark); 
end AtJMark; 


end Ring_Sequential_Bounded_JlanagedJIoniterator; 
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RING SEQUENTIAL BOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Ring_Sequent ial_BoimdedLJManagecLNoni terator 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronuThe_Ring : Ring, 

To_The_Ring : Ring 
OUTPUT 

To_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

’Rie.Jling : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_Item : Item, 

In_The_Ring : Ring 
OUTPUT 

In^The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 


The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Rotate 

SPECIFICATION 

INPUT 

The_Ring : Ring, 

In_The_Direction : Direction 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Mark 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate_To_Mark 

SPECIFICATION 

INPUT 

The_Ring ; Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

END 

IMPLEMENTATION ADA 

Ring_Sequential_BoundecLManaged_Noniterator 

END 
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RING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

package Ring_Sequential_Unbovinde<3jManaged_Iterator is 
type Ring is limited private; 
type Direction is (Forward, Backward); 


procedure Copy 
Ring; 

Ring); 

procedure Clear 
Ring); 

procedure Insert 
I tern; 

Ring); 

procedure Pop 
Ring); 

procedure Rotate 
Ring; 

Direction); 

procedure Mark 
Ring); 

procedure Rotate_To^Mark 
Ring); 

— modified by Tuan Nguyen 
10 January 1996 

— adding procedures to repl 


(FronuThe_Rang : xn 

To_The_Ring : in out 

(The_Ring : in out 

(The_Item : in 

In_The_Ring : in out 

{The_Ring : in out 

{The_Ring : in out 

In_The_Direction : in 

(The_Ring : in out 

(The_Ring : in out 

ace functions 


procedure Is_Equal (Left : in Ring; 

Right : in Ring; 
Result ; out Boolean); 
procedure Extent_Of (The_Ring : in Ring; 

Result : out Natural); 
procedure Is_Enpty (The_Ring : in Ring; 


Result : out Boolean); 
procedure Top^Of (The_Ring : in Ring; 

Result : out Item); 
procedure At_Mark (The_Ring : in Ring; 

Result : out Boolean); 

— end of modification 

function Is_Equal (Left : in Ring; 

Right : in Ring) return 

Boolean; 

function Extent_0f (The_Ring : in Ring) return 
Natural; 

function Is_Enpty {The_Ring : in Ring) return 
Boolean; 

function Top_Of (The_Ring ; in Ring) return 
Item; 

function At_Mark (The_Ring : in Ring) return 
Boolean; 

generic 

with procedure Process (The_Item : in Item; 

Continue : out 

Boolean); 

procedure Iterate (Over_The_Ring ; in Ring); 

Overflow : exception; 

Underflow : exception; 

Rotate_Error : exception; 

private 

type Node; 

type Structure is access Node; 
type Ring is 
record 

The_Top : Structure; 

TheJMark : Structure; 
end record; 

end Ring_Sequential_Unboiinded_Managed_Iterator ; 
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RING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Niimber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Cowputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with StorageJManager^Seguential; 

package body Ring_Sequential_UnboundedJlanaged_Iterator 
is 


type Node is 
record 

Previous ; Structure; 
The_Item : Itern; 

Next ; Structure; 
end record; 


procedure Free (The_Node : in out Node) is 
begin 

The^Node.Previous ;= null; 
end Free; 


procedure Set_Next (The_Node : in out Node; 

To_Next : in Structure) is 

begin 

The_Node.Next := ToJJext; 
end Set_Next; 

function Next_Of (The_Node : in Node) return 
Structure is 
begin 

return TheJNode.Next; 
end Next_Of; 


package NodeJManager is new 
Storage_Manager_Sequential 

Node, 

Structure, 

Free -> 

Set_Pointer => 
Pointer_Of => 


(Item => 

Pointer => 

Free, 

Set^ext, 
Next^Of); 


procedure Copy (FrortuThe_Ring : in Ring; 

To_The_Ring : in out Ring) is 
From_Index : Structure 
Fron\_The_Ring. The_Top; 

To_Index : Structure; 
begin 

if To_The_Ring.‘Ihe_Top /= null then 

To_The_Ring.The^Top.Previous.Next ;= null; 
Node_M 2 ujager. Free (To_The_Ring. TheJTop) ; 
end if; 

if From_The_Ring.The_Top = null then 
To_The_Ring.The_Mark := null; 

else 


To_„The_Ring. The_Top : = 

Node_Manager .New_Item; 

To^The_Ring.The_Top.The_Item : = 

From_Index. The_Item; 

To_Index To_The_Ring, The_Top ; 
if FroiiL.The_Ring.The_Kark = From_Index then 
To_The_Ring.The_Mark := To^Index; 
end if; 

From_Index : = From.>Index. Next; 

while From^Index /= FroiiL.The_Ring. The_Top 

loop 

To_Index.Next := NodeJManager.New_Item; 
To_Index.Next.Previous := To_Index; 

To_Index.Next.The_Itern := 

Fronulndex. The_I tern; 

To_Index := To^Index.Next; 
if FronuThe_Ring.TheJlark = From_Index 

then 


To_The_Ring.TheJSlark To_Index; 
end if; 

FronuIndex := From_lndex.Next; 
end loop; 

To_The_Ring,The^Top.Previous := To^Index; 
To_Index.Next := To_The_^ing.The_.Top; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Ring : in out Ring) is 


begin 

if The_Ring.The_Top /= null then 

The_Ring. The_Top. Previous.Next : = null ; 
Node_McUiager. Free ('rhe_Ring. The_Top) ; 
The_Ring,The_Mark := null; 
end if; 
end Clear; 


procedure Insert {The_Item : in Item; 

In>.The_Ring : in out Ring) is 
Teir 5 >orary_Node : Structure; 
begin 

if In_The_Ring.TheJTop = null then 

In_The_Ring. TheJTop : = 

Node_J4anager. New_I tern; 

IrjThe^Ring. TheJTop. Previous : = 

In_The_Ring.The_Top; 

In^The_Ring.The_Top.The_Item := The_Item; 

IrL.The_Ring. The_Top. Next : = 

In_The_Ring,TheJTop; 

In_The_Ring.The_Mark := 

In_The_Ring.The_Top; 
else 

Temperary_Node Node_Manager .New_Item; 

TemporaryjNode. Previous ; = 

In_The_Ring.TheJTop.Previous; 

Tenp>orary_Node.The_Item := The_Item; 

Tenporary_Node.Next := In_The_Ring.The__Top; 

In_The_Ring. The_Top : = TemporaryJNTode ; 

ln_The_Ring.The_Top.Next.Previous := 
In_The_Ring.The_Top; 

In_The_Ring. The_Top. Previous. Next : = 
In^The_Ring.The_Top; 
end if; 
exception 

when Storage_Error => 

raise Overflow; 
end Insert; 


procedure Pop(The_Ring : in out Ring) is 
TenporaryJJode ; Structure ; 
begin 

Teirporary_Node ;= The^Ring, The_Top ; 
if The_Ring.The__Top = The_Ring.The_Top.Next 

then 

The_Ring.The_Top := null; 

The_Ring. TheJIark : = nul 1; 

else 

The_Ring.The_Top.Previous.Next := 
The_Ring.The_Top.Next; 

'Ihe_Ring. The_Top. Next. Previ ous : = 
The_Ring.The_Top.Previous; 

if The_Ring, The_Mark = The_Ring. The_Top 

then 


The_Ring.The_Mark ;= 

The_Ring.The_Top.Next; 

end if; 

The_Ring.The_Top r= The_Ring.The_Top.Next; 
end if; 

Teirporary_Node.Next := null; 

NodeJManager. Free (TemporaryJJode) ; 
exception 

when Constraint_Error => 
raise Underflow; 


end Pop; 


procedure Rotate (The_Ring : in out Ring; 

In_The_Direction : in 

Direction) is 
begin 

if In_The_Direction = Forward then 

The_Ring.The_Top := TheJRing.The_Top.Next; 

else 

The_Ring.The_Top := 

The_Ring.The_Top.Previous; 
end if; 
exception 

when Constraint_Error => 
raise Rotate_Error; 
end Rotate; 

procedure Mark (The_Ring : in out Ring) is 
begin 

The_Ring.The_Mark := The_Ring.The_Top; 
end Mark; 

procedure Rotate_ToJ4ark (The_Ring : in out Ring) 
is 

begin 

The_Ring.The_Top := The_Ring.The_Mark; 
end Rotate_To_Mark; 

— modified by Tuan Nguyen 
10 January 1996 

— adding procedures to replace functions 

procedure Is_Equal (Left : in Ring; 

Right : in Ring; 
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Result : out Boolean) is 

begin 

Result := Is^Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Ring : in Ring; 

Result : out Natural) is 

begin 

Result := Extent_0f{The_Ring); 
end Extent_Of; 

procedure Is_Eapty {The_Ring : in Ring; 

Result : out Boolean) is 

begin 

Result : = Is_Enpty (The_Ring) ; 
end Is_Eitpty; 

procedure Top_Of (The_Ring : in Ring; 

Result : out Item) is 

begin 

Result := Top_Of(The_Ring); 
end Top^Of; 

procedure At_Nark {The_Ring ; in Ring; 

Result : out Boolean) is 

begin 

Result := At_Mark(The_Ring); 
end At_Marh; 


end of modification 


f\inction Is_Equal (Left : in Ring; 

Right r in Ring) return Boolean 
is 

Left_Index : Structure ;= Left.The^Top; 
Right_Index : Structure ;= Right.The_Top; 
begin 

if Left_Index.The_Itein /= Right_Index.The_Item 

then 

return False; 

elsif (Left.TheJiark = Left_Index) and then 
(Right.The^rk /= Right^Index) then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_Index := Right^Index.Next; 
while Left_lndex /= Left.The^Top loop 
if Left_Index.The_Item /= 
Right_Index.The_Item then 

return False; 

elsif (Left.The_Mark = Left_Index) and 


(Right.The,^rk /« Right.Index) then 
return False; 


Left_lndex ;= Left_lndex.Next; 
Right_Index ;= Right_Index,Next; 
end if; 
end loop; 

return (Right_Index = Right.The_Top); 
end if; 
exception 


when Constraint^Error => 

return (Left.TheJTop = Right.The_Top); 
end Is_Equal; 

function Extent_Of (The_Ring ; in Ring) return 
Natural is 

Count : Natural := 0; 

Index : Structure ;= The_Ring.The_Top; 
begin 

Index ;= Index.Next; 

Count := Cotmt + 1; 

while Index /= The^Ring.The_Top loop 
Co\jnt Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
exception 

when Constraint_Error -> 
return 0; 
end Extent_Of; 


function Is_Empty (The_Ring : in Ring) return 
Boolean is 
begin 

return (The_Ring.The_Top = null); 
end Is^Ecpty; 

function Top_Of (The_Ring : in Ring) return Item is 
begin 

return The_Ring. The_Top. The_Itern; 
exception 

when Constraint_Error «> 
raise Underflow; 
end Top_Of; 

function At_Mark (The_Ring ; in Ring) return 
Boolean is 
begin 

return (The_Ring.The_Top = The_Ring.The_Mark); 
end AtJIark; 

procedure Iterate (Over_The_Ring : in Ring) is 
The_Iterator : Structure := 

Over_The_Ring. The_Top ; 

Continue ; Boolean; 

begin 

if The_Iterator /= null then 

Process(The_Iterator.The_Itern. Continue}; 
if Continue then 

The^Iterator ;= The_Iterator.Next; 
while not (The_lterator = 

Over_The_Ring.The_Top) loop 

Process(The_Iterator.The_Item, 

Continue); 

exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end if; 
end if; 
end Iterate; 


end Ring_Sequential_Unbounded_Managed_Iterator; 
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RING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 


PSDL 


TYPE Ring_Sequent ial_Unboxmded,J4anagecLI terator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Ring : Ring, 

To_The_Ring : Ring 
OUTPUT 

To_The_Ring ; Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_Item : Item, 

In_The_Ring : Ring 
OUTPUT 

IrL.The_Ring ; Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate 
SPECIFICATION 
INPUT 

The_Ring : Ring, 

In_TheJ3irection : Direction 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Mark 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate„To_Nark 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 


The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Is^Equal 

SPECIFICATION 

INPUT 

Left : Ring, 

Right : Ring 
OUTPUT 

Result : Booleemi 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Is„Errpty 

SPECIFICATION 

INPUT 

The_Ring ; Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR At_Nark 

SPECIFICATION 

INPUT 

The^Ring : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : in[t : Item] 
Continue : out[t : Boolean]] 

INPUT 

Over_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

END 

IMPLEMENTATION ADA 

Ring_Seguential_Unbounded_ManagedLIterator 

END 
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RING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

package Ring_Seciuential_UnboxindecLManagec3LJJoniterator 
is 

type Ring is limited private; 


type Direction is {Forward, Backward) ; 


procedure 

Ring; 

Copy 

(From_The_Ring 

To_The_Ring 

in 

out 


in 

Ring); 


(The_Ring 

in 

out 

procedure 

Clear 

Ring); 





procedure 
I tern; 

Insert 

(The^Item 

In_The_Ring 

in 

out 


in 

Ring); 


(The_Ring 


out 

procedure 

Pop 

in 

Ring); 

procedure 

Ring; 

Rotate 

(The_Ring 

in 

out 

In^The_Direc tion 

in 



Direction); 


(The__Ring 

in 

out 

procedure 

Mark 

Ring); 


(The_Ring 

in 

out 

procedure 

Ro t a te_To^ark 


Ring); 

— modified by Tuan Nguyen 

— 10 January 1996 

— adding procedures to replace fxinctions 

procedure Is_Equal (Left : in Ring; 

Right : in Ring; 

Result : out Boolean); 


procedure Extent_0f {The^Ring : in Ring; 

Result : out Natural); 
procedure Is_Einpty {The_Ring : in Ring; 

Result ; out Boolean) ; 
procedure Top^Of (The_Ring : in Ring; 

Result : out Item) ; 
procedure Atjlark (The_Ring : in Ring; 

Result : out Boolean); 


end of modification 


f\inction Is_Egual 

Boolean; 

(Left 

Right 

: in 
; in 

Ring ; 
Ring) 

return 

function Extent_0f 
Natural; 

{The_Ring : 

; in 

Ring) 

return 

function Is^Eirpty 
Boolean; 

(The_Ring ; 

I in 

Ring) 

return 

function Top_0f 
Item; 

(The_Ring ; 

: in 

Ring) 

return 

function AtJWark 
Boolean; 

(The_Ring ; 

; in 

Ring) 

return 


Overflow : exception; 
Underflow ; exception; 
Rotate^Error : exception; 


private 

type Node; 

type Structure is access Node; 
type Ring is 
record 

The_Top : Structure; 

The_Mark : Structured- 
end record; 

end Ring_Sequent ial_Unbounded_ManagedJJoni t era tor; 
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RING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) <3) 

(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with StorageJManager_Sequential; 
package body 

Ring_Sequential_Unbounded^anaged_lIoniterator is 

type Node is 
record 

Previous 
The_Item 
Next 

end record; 

procedure Free (The_Node ; in out Node) is 
begin 

The_Node.Previous := null; 
end Free; 

procedure Set_Next (The_Node : in out Node; 

To^Next ; in Structure) is 

begin 

The_Node.Next := To_JJext; 
end Set_Next; 

function Next_Of (The^ode : in Node) return 
Structure is 
begin 

return The^Node.Next; 
end Next_Of; 


Structure; 

Item; 

Structure; 


package Node_Jlcuiager is new 
S torage_Na2ia5e3^—Sequent ia 1 

Node, 


(Item => 

Pointer => 


Structure, 

Free => Free, 

Set_Pointer => SetJtJext, 
Pointer^Of => Next^Qf); 


procedure Copy (From_The_Ring : in Ring; 

To_The_Ring : in out Ring) is 
From_Index : Structure 
From_The_Ring.The_Top; 

To_Index : Structure; 
begin 

if To_The_Ring.TheJTop /= null then 

To_The_Ring.The_Top.Previous.Next := null; 
NodeJd^ager.Free(To_The_Ring,The_Top); 
end if; 

if From_The_Ring.The_Top = null then 
To_The_Ring-The^Mark := null; 

else 

To_The_Ring.The_Top :- 
Node_Manager. New_I t em 

To_The_Ring.The_Top.The_Item := 

From_Index.The_Itern; 

To_Index To_The_Ring.The_Top; 

if FroiiuThe_Ring,The_Mark = From_Index then 
To_The_Ring.TheJMark := To_Index; 
end if; 

Fronuindex := FronuIndex.Next; 

while From_Index /= Froitt_The_Ring. The^Top 

loop 

To_Index. Next : = NodeJManager. New_Item; 
To_Index. Next. Previous : = To^Index; 
To_Index.Next.The_Item := 

Front-Index. The_I tern; 

To_Index := To_Index.Next; 
if From_The_Ring.The_Mark = From_Index 


then 


To_The_Ring.The_Mark ;= To_Index; 
end if; 

From_Index := FroituIndex.Next; 
end loop; 

To_The_Ring-The_Top.Previous := To_Index; 
To_Index.Next := To_The_Ring.The_Top; 
end if; 
exception 

when Storage_Error => 
raise (Overflow; 


end Copy; 


procedure Clear (The_Ring : in out Ring) is 


begin 

if The_Ring.The_Top /= null then 

The_Ring.The_Top.Previous,Next := null; 
NodeJManager.Free(The_Ring.The_Top); 
The_Ring.The_Mark := null; 
end if; 
end Clear; 


procedure Insert (The_Item ; in Item; 

In_The_Ring : in out Ring) is 
TeirporaryJ^ode : Structure; 
begin 

if In_The_Ring.The_Top = null then 

In_TheJRing.The_Top : = 

NodeJianager. New_I tern ; 

In_TheJRing. The_Top. Previous : = 

In_The_Ring. The_Top ; 

In_The_Ring.The_Top.The_Item := The_Item; 

In._The_Ring.The_Top.Next ; = 

In_The_Ring.The_Top; 

In_The_Ring.The_Mark := 

In_The_Ring.The_Top; 
else 

Tenporary_Node := Node_Manager .New_Item; 

Tenporary_Node.Previous := 

In_The_Ring. The_Top. Previous ; 

Temporary_Node.The_Item := The_Item; 

Teit^joraryJlode. Next : = In_The_Ring. The_Top; 

In_The_Ring.The_Top := Temporary_Node; 

In_The_Ring, The_Top. Next. Previous : = 
In_The_Ring.The_Top; 

In_The_Ring. The_Top - Previous.Next : = 
In_The_Ring.The_Top; 
end if; 
exception 

when Storage_Error => 

raise Overflow; 
end Insert; 


procedure Pop(The_Ring : in out Ring) is 
Ten^orary_Node : Structure; 
begin 

Temper aryJNode := The_Ring. The_Top ; 
if The_Ring.The_Top = The_Ring.The_Top.Next 

then 

The_Ring.The_Top := null; 

The_Ring.The_JIark : = null; 

else 

The^Ring. The_Top, Previous .Next : = 
The_Ring.The_Top.Next; 

The_Ring. The_Top. Next. Previ ous : = 
The_Ring.The_Top.Previous; 

if The_Ring.The_Mark = The_Ring.The_Top 


then 


The_Ring.The_.Mark : = 

The_Ring.The_Top.Next; 

end if; 

The_Ring.The_Top := The_Ring.The_Top.Next; 
end if; 

TemporaryJNode.Next := null; 

Node_Manager.Free(Temperary_Node); 
exception 

when Constraint_Error => 
raise Underflow; 


end Pop; 


procedure Rotate (The_Ring : in out Ring; 

In_The_Direction : in 

Direction) is 
begin 

if In_The_Direction =: Forward then 

The_Ring.The_Top := The_Ring.The_Top.Next; 

else 

The_Ring.The_Top := 

The_Ring,The_Top.Previous; 
end if; 
exception 

when Constraint_Error => 
raise Rotate_Error; 
end Rotate; 

procedure Mark (The_Ring : in out Ring) is 
begin 

The_Ring.The_Mark := The_Jling.The_Top; 
end Mark; 

procedure Rotate_To_^ark (The_Ring ; in out Ring) 
is 

begin 

The_Ring.The_Top := The_Ring.The_Mark; 
end Rotate_To_Mark; 


— modified by Tuan Nguyen 

— 10 January 1996 

— adding procedures to replace 


functions 


procedure Is_Equal (Left 
Right 


in Ring; 
in Ring; 
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Result : out Boolean) is 


begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent^Of (The_Ring : in Ring; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Ring); 
end Extent_Of; 

procedure Is_Empty (The^Ring : in Ring; 

Result : out Boolean) is 

begin 

Result : = Is^Eitpty {The^Ring); 
end Is_Eiiipty; 

procedure Top_Of (The^Ring : in Ring; 

Result : out Item) is 

begin 

Result := Top_Of(The_Ring); 
end Top_Of; 

procedure At_Mark (The_Ring : in Ring; 

Result : out Boolean) is 

begin 

Result ;= At_Mark(The_Ring); 
end At_Mark; 

— end of modification 

function Is^Equal (Left : in Ring; 

Right : in Ring) return Boolean 
is 

Left_Index : Structure := Left.The_Top; 
Right_Index : Structure ;= Right.The^Top; 
begin 

if Left_Index.The_Item /= Right_Index.The_Item 

then 

return False; 

elsif (Left,The_Mark = Left_Index) and then 
(Right.The_Nark /= Right_Index) then 
return False; 

else 

Left_Index := Left_Index.Next; 

Right_Index ;= Right_Index.Next; 
while Left_Index /= Left.The_Top loop 
if Left_lndex.The_Item /= 

Right_Index.The_Itern then 

return False; 

elsif (Left.TheJlark = Left_Index) and 

then 


(Right.The_Nark /= Right_Index) then 
return False; 

else 

Left_Index := Left_Index.Next; 
Right_Index := Right^Index.Next; 
end if; 
end loop; 

return (Right_Index = Right.The_Top); 
end if; 
exception 

when Constraint_Error => 

return (Left.The_Top = Right.The_Top); 
end Is^Equal; 

function Extent_Of (The_Ring ; in Ring) return 
Natural is 

Coxint : Natural := 0; 

Index ; Structure := The_Ring.The_Top; 
begin 

Index ;= Index.Next; 

Count := Count + 1; 

while Index /= The_Ring.The_Top loop 
Co\int Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
exception 

when Constraint_Error *> 
return 0; 
end Extent_Of; 

function Is^Empty (The_Ring : in Ring) return 
Boolean is 
begin 

return (The_Ring.The_Top = null); 
end Is_Eirpty; 

ftinction Top_Of {The_Ring : in Ring) return Item is 
begin 

return The^Ring.The^Top,The_Item; 
exception 

when Constraint_Error s> 
raise Underflow; 
end Top_Of; 

function At_Mark (The_Ring : in Ring) return 
Boolean is 
begin 

return (The^Ring.The_Top = The_Ring.The_Mark); 
end At^Nark; 

end Ring_Sequential_Unbounded_^IanagedJHoniterator; 
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RING SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Ring_Sequential_UnLbounded_Jlanaged_Noniterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroiiuThe_Ring : Ring, 

To_The_Ring : Ring 
OUTPUT 

To_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The„Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_I t em : I tern, 

In_The_Ring : Ring 
OUTPUT 

In_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The^Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate 
SPECIFICATION 
INPUT 

The_Ring : Ring, 

In_The_pirection : Direction 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Mark 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 


OPERATOR Rotate_To_Mark 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring ; Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR ls_Egual 

SPECIFICATION 

INPUT 

Left : Ring, 

Right ; Ring 
OUTPUT 

Result : Booleein 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR IsJEn^ty 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR AtJlark 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

END 

IMPLEMENTATION ADA 

Ring_Sequent i al_Unbounded_JIanaged_Noni t era tor 
END 
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RING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

package Ring_Sequential_UnboundedLUnmanageca_Iterator is 
type Ring is limited private; 
type Direction is (Forward, Backward); 


procedure Copy 
Ring ; 

Ring); 

procedure Clear 
Ring); 

procedure Insert 
Item; 

Ring); 

procedure Pop 
Ring); 

procedure Rotate 
Ring ; 

Direction); 

procedure Mark 
Ring); 

procedure Rotate_To_Mark 
Ring); 


(FroirL_The_Ring 
To_The_Ring 
(The_Ring 
(The_Item 
In_The_Ring 
(The_Ring 
(The_Ring 


: in 

: in out 
: in out 
: in 

: in out 
: in out 
: in out 


In_The_Direction : in 


{The_Ring 


: in out 


{The_Ring : in out 


modified by Tuan Nguyen 


— 10 January 1996 

— adding procedures to replace fvinctions 


procedure Is^Equal (Left : in Ring; 

Right : in Ring; 

Result : out Boolean); 

procedure Extent_0f (The_Ring : in Ring; 

Result : out Natural); 

procedure Is_En?>ty (The_Ring : in Ring; 


Result : out Boolean); 
procedure Top_Of (The_Ring ; in Ring; 

Result : out Item) ; 
procedure At_Mark (The^Ring : in Ring; 

Result : out Boolean); 

— end of modification 

fxmction Is_Equal (Left : in Ring; 

Right ; in Ring) return 

Boolean; 

function Extent_0f (The_Ring ; in Ring) return 
Natural; 

function ls_Empty (The^Ring : in Ring) return 
Boolean; 

function Top_Of {The_Ring : in Ring) return 
Item; 

function AtJMark (The_Ring : in Ring) return 
Boolean; 

generic 

with procedure Process (The^Item : in Item; 

Continue : out 

Boolean); ... 

procedure Iterate (Over_The_Ring : in Ring); 

Overflow : exception; 

Underflow : exception; 

Rotate_Error : exception; 

private 

type Node; 

type Structure is access Node; 
type Ring is 
record 

The_Top : Structure; 

The_Mark : Structure; 
end record; 

end Ring_Seguential_Unbounded_Unmanaged_Iterator; 
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RING SEQUENTIAL UNBOUNDED UNMAN AGED ITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Nxjinber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Kcinufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package body 

Ring_Sequential_Unbounded_Unmanaged^Iterator is 

type Node is 
record 

Previous : Structure; 

The_Item : I tern; 

Next : Structure; 
end record; 


procedure Copy {Fron\_The_Ring ; in Ring; 

To_The_Ring : in out Ring) is 
Fronuindex : Structure :« 

FroituThe_Ring - The^Top; 

To_Index ; Structure; 
begin 

if PronuThe_Ring.The_Top = null then 
To_The_Ring.The_Top := null; 

To_The_Ring.The_^rk := null; 

else 

To_The_Ring. The_Top :s=! new Node'(Previous 

=> null, 

The^Item 

=> FronL.Index.The_Item, 

Next 

»> null); 

To_Index := To_The_Ring.The_Top; 
if FronuThe_Ring.The_Nark = Froituindex then 
To_The_Ring.TheJIark := To_Index; 
end if; 

From_Index := From_Index.Next; 

while Fronuindex /= From_The_Ring.The^Top 

loop 

To_Index.Next := new Node *(Previous => 

To_Index, 

The_Item => 

From_Index.The_Item, 

Next => 

null); 

To_Index To_Index.Next; 

if FroiiL.The_Ring. The_Nark = Fronulndex 

then 

To_The_Ring.The_Mark ;= To_Index; 
end if; 

From_lndex := From_Index.Next; 
end loop; 

To_The_Ring. The_Top. Previous ; 5 = To_Index ,- 
To^Index.Next := To_The_Ring.The^Top; 
end if; 
exception 

when Storage^Error *> 
raise Overflow; 
end Copy; 

procedure Clear (The_Ring : in out Ring) is 
begin 

The^Ring := Ring'(The_Top => null, 

The_Mark => null); 

end Clear; 


procedure Insert (The__Item : in Item; 

In_The_Ring : in out Ring) is 

begin 

if In_The_Ring.The_Top = null then 

In_The_Ring.The_Top := new Node‘(Previous 

5=> null, 

The_Item 

s:> The_Item, 

Next 


=> null); 

In_The_Ring.The_Top.Previous := 
In_The_Ring. The_Top ; 

In_The_Ring.The_Top•Next := 
In_The_Ring. The_Top ; 

In_The_Ring.TheJKark : = 
In_The_Ring.The_Top; 
else 

In_The_Ring.The_Top := 
new Node'{Previous => 
IrL_The_Ring. The_Top. Previous, 

The_Item => The_Item, 


Next => 

In_The_Ring.The_Top) ; 

In_The_Ring.The_Top.Next.Previous := 
Inw.The_Ring. The_Top ; 

In_The_Ring.The_Top.Previous,Next := 
In^The„Ring. The_Top; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Insert; 


procedure Pop(The_Ring : in out Ring) is 
begin 

if The_Ring.The_Top - The_Ring.The_Top.Next 

then 

The_Ring.The_Top ;= null; 

The_Ring.The_Mark := null; 

else 

The_Ring. The_Top. Previous .Next :» 
The_Ring.The_Top.Next; 

The_Ring. The_Top. Next. Previous : = 
The_Ring.The_Top.Previous; 

if The_Ring.The_Mark = The_Ring.The_Top 


then 


The_Ring. The_Mark : = 

The_Ring. The_Top. Next; 

end if; 

The_Ring,The_Top ;= The_Ring,The_Top.Next; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 


end Pop; 


procedure Rotate (The_Ring ; in out Ring; 

In_The_Direction ; in 

Direction) is 
begin 

if In_The_Direction = Forward then 

The_Ring.The_Top := The_Ring.The_Top.Next; 

else 

The_Ring, The_Top ; == 

The_Ring.The_Top.Previous; 
end if; 
exception 

when Constraint_Error => 
raise Rotate_Error; 
end Rotate; 

procedure Mark (The_Ring : in out Ring) is 
begin 

The_Ring. The_Mark : The_Ring. The_Top ; 
end Mark; 

procedure Rotate_To_Mark (The_Ring : in out Ring) 
is 

begin 

The_Ring.The_Top := The_Ring.The_Mark; 
end Rotate_To_Mark; 

— modified by Tuan Nguyen 

— 10 January 1996 

— adding procedures to replace functions 

procedure Is_Equal (Left ; in Ring; 

Right : in Ring; 

Result : out Boolean) is 

begin 

Result ;= Is_Equal(Left,Right); 
end Is_Ec 5 ual; 

procedure Extent_Of (The_Ring : in Ring; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Ring); 
end Extent_0f; 

procedure Is_Einpty (The_Ring ; in Ring; 

Result : out Boolean) is 

begin 

Result := Is_Einpty (The_Ring) ; 
end Is_Enqpty; 

procedure Top_Of (The_Ring ; in Ring; 

Result : out Item) is 

begin 

Result i- Top_0f(The_Ring); 
end Top_Of; 

procedure At_Mark (The_Ring ; in Ring; 

Result ; out Boolean) is 

Jsegin 

ResuIt := AtJMark(The_Ring); 
end At_Mark; 

— end of modification 
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function Is^Equal {Left : in Ring; 

Right : in Ring) return Boolean 
is 

Left_Index : Structure := Left.The_Top; 
Right_Index : Structure := Right.The_Top; 
begin 

if Left_Index.The_Item /= Right_Index,The_Item 

then 

return False; 

elsif (Left.The_Mark = Left_Index) and then 
(Right.The^Mark /= Right_Index) then 
return False; 

else 

Left_Index Left_Index.Next; 

Right_Index := Right_Index.Next; 
while Left_Index /= Left.The^Top loop 
if Left_Index,The_Item /= 

Right_Index.The_Item then 

return False; 

elsif (Left.The_Wark = Left^Index) and 


then 

(Right.TheJMark /= Right_Index) then 
return False; 

else 

Left_Index := Left_Index-Next; 
Right_Index := Right_Index,Next; 
end if; 
end loop; 

return (Right_Index = Right.The^Top); 
end if; 
exception 

when Constraint_Error => 

return (Left .The_Top = Right .'Ihe_Top) ; 
end Is^Ecjual; 


function Extent_Of (The_Ring : in Ring) return 
Natural is 

Count ; Natural 0; 

Index : Structure The_Ring.The_Top; 

begin 

Index := Index.Next; 

Coimt := Count + 1; 

while Index /= The_Ring.The_Top loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 


exception 

when Constraint_Error => 
return 0; 
end Extent_Of; 

function Is_Einpty {The_Ring : in Ring) return 
Boolean is 
begin 

return {'Ihe_Ring.The_Top = null) ; 
end Is^Ernpty; 

function Top_Of (The_Ring : in Ring) return Item is 
begin 

re turn The_Ring. The^Top. The_I tern ; 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_Of; 

function At_Nark (The_Ring : in Ring) return 
Boolean is 
begin 

re turn (The^Ring.The^Top = The_Ring.The Jlark); 
end At_Mark; 

procedure Iterate (Over_The_Ring : in Ring) is 
The_Iterator : Structure := 

Over_The_Ring. The_Top; 

Continue : Boolean; 

begin 

if The_Iterator /= null then 

Process(The_Iterator.The_Item, Continue); 
if Continue then 

The_Iterator The_Iterator.Next; 

while not (The_Iterator = 
Over_The_Ring.The_Top) loop 

Process(The_Iterator.The_Itern. 

Continue); 

exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end if; 
end if; 
end Iterate; 

end Ring^Sequent ial„UnboundecLUninanaged_I t erator; 
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RING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

PSDL 


TYPE Ring_Sequential_Unbounded_Uninanaged_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Front.The_Ring : Ring, 

To_The_Ring : Ring 
OUTPUT 

To_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Ring ; Ring 
OUTPUT 

The^Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_Item : Item, 

IrL.The_Ring : Ring 
OUTPUT 

In_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate„Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring ; Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate 
SPECIFICATION 
INPUT 

The_Ring : Ring, 

In_The_Direction : Direction 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Mark 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The__Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate_To_Mark 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 


The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Is_Egual 

SPECIFICATION 

INPUT 

Left : Ring, 

Right : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Is„Etnpty 

SPECIFICATION 

INPUT 

The^Ring ; Ring 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR At Jlark 

SPECIFICATION 

INPUT 

The^Ring : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern ; in[t : Item] 
Continue : out(t : Boolean]] 

INPUT 

Over_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

END 

IMPLEMENTATION ADA 

Ring_Sequential_Unbounded_Unmanaged_Iterator 

END 
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RING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Ring„Sequential_Unbounded_Uninanaged_Noniterator 

is 

type Ring is limited private; 

type Direction is (Forward, Backward); 


procedure Copy 
Ring; 

Ring); 

procedure Clear 
Ring); 

procedure Insert 
I tern; 

Ring); 

procedure Pop 
Ring); 

procedure Rotate 
Ring; 

Direction); 

procedure Mark 
Ring) ; 

procedure Ro t ate_To_Mark 
Ring) ; 

— modified by Tuan Nguyen 

— 10 January 1996 

adding procedures to rep! 


(FrortuThe_Ring : in 

To_The_Ring : in out 

(The_Ring : in out 

(The_Item : in 

In_The_Ring : in out 

(The_Ring : in out 

{The_Ring : in out 

In_The_Direction : in 

{The_Ring : in out 

(The_Ring : in out 


functions 


procedure Is^Egual (Left ; in Ring; 

Right : in Ring; 

Result : out Boolean); 


procedure Extent_Of (The_Ring : in Ring; 

Result : out Natural); 
procedure Is_Eiipty {The_Ring : in Ring; 

Result : out Boolean); 
procedure Top_0£ {The_Ring : in Ring; 

Result : out Item); 
procedure At_>Iark (The_Ring : in Ring; 

Result : out Booleain); 

— end of modification 

function Is_Equal (Left : in Ring; 

Right : in Ring) return 

Boolean; 

function Extent_Of (The_Ring : in Ring) return 
Natural; 

function Is_Empty (The_Ring : in Ring) return 
Boolean; 

function Top_0f (The_Ring : in Ring) return 
Item; 

function At_Mark (The_Ring : in Ring) return 
Boolean; 

Overflow : exception; 

Underflow : exception; 

Rotate_Error : exception; 

private 

type Node; 

type Structure is access Node; 
type Ring is 
record 

The_Top ; Structure; 

The_Mark : Structure; 
end record; 

end Ring_Sequential_Unbounded^UnmcinagecLKoniterator; 
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RING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is siobject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 {1-303-987-1874} 


package body 

Ring_Sequential_Unbo\jnded_Uninanaged^Noniterator is 


type Node is 
record 

Previous : Structure; 
The_ltem : Item; 

Next : Structure; 

end record; 


procedure Copy (FroiTL.The_Ring : in Ring; 

To_The_Ring : in out Ring) is 
Fronuindex : Structure := 

FrortL_The_Ring. The_Top; 

To_Index : Structure; 
begin 

if FrotrL.The_Ring.The_Top = null then 
To_The_Ring-The_Top := null; 

To_The_Ring.Thejlark null; 

else 

To_The_Ring.The_Top := new Node‘ (Previous 

=> null, 

The_Item 

=> FroiiL_Index.The_Item, 

Next 


=> null); 


loop 

To^Index, 


To^Index := To_The_Ring.The_Top ; 
if From_The_Ring.The_Mark = Froituindex then 
To_TheJRing.TheJttark ;= To_Index; 
end if; 

Fron\_Index : = Fron\_Index. Next; 

while Fronuindex FrortuThe_Ring. The_Top 

To_Index.Next ;= new Node'{Previous => 

The_Item => 


Fr onuindex. 'nie_I tem, 


Next => 


null); 

To„Index := To_Index.Next; 
if”Froir\_The_Ring.The_Mark = Fronuindex 


then 


To_The_Ring.The^Mark := To^Index; 
end if; 

Fronuindex := Fronuindex.Next; 
end loop; 

To_Thc_Ring.The_Top.Previous := To_Index; 
To_Index.Next := To_The_Ring.The_Top; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Ring : in out Ring) is 
begin 

The_Ring :!s Ring' (The_Top => null, 
The_Mark => null); 

end Clear; 


procedure Insert {The„Item : in Item; 

In_The_Ring : in out Ring) is 

begin 

if In_The_Ring.The^Top = null then 

In_The_Ring.The_Top := new Node'(Previous 


=> null. 


The_Item 


=> The^Item, 


Next 


=> null); 

In_The__Ring. The_Top, Previous : = 
In_The_Ring.The_Top; 

In^The_Ring. The_Top - Next : = 
InuThe_Ring. The_Top; 

In_The_Ring,The_Mark := 
IruThe_Ring.The_Top; 
else 

In^The_Ring.The_Top := 
new Node'(Previous => 
In_The_Ring .The_Top. Previous, 

The^Item => The_Item. 


Next => 

In_The_Ring.The^Top); 

In_The_Ring.The_Top.Next.Previous := 
In_The_Ring.The_Top; 

In_The_Ring. The_Top. Previ ous . Next : = 
In_The_Ring.The_Top; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Insert; 


procedure Pop(The_Ring : in out Ring) is 
begin 

if The_Ring.The_Top = The_Ring.The__Top.Next 

then 

The_Ring.The_Top ;= null; 

The_Ring.The_Mark := null; 

else 

The__Ring. The_Top. Previous. Next : = 
The_Ring.The_Top.Next; 

The_Ring.The_Top.Next.Previous := 
The_Ring.The_Top.Previous; 

if The_Ring.The.Jlark = The_Ring.The_Top 


then 


The_Ring.The_Mark ;= 

The_Ring.The_Top.Next; 

end if; 

The_Ring.The_Top := The_Ring,The_Top.Next; 
end if; 
exception 

when Constraint_Error => 
raise Underflow; 


end Pop; 


procedure Rotate (The_Ring : in out Ring; 

In_The_Direction : in 

Direction) is 
begin 

if ln_The_Direction = Forward then 

The_Ring. The_Top ; = The_Ring. The_Top. Next; 

else 

The_Ring.The_Top :* 

The_Ring.The_Top.Previous; 
end if; 
exception 

when Constraint_Error «> 
raise Rotate_Error; 
end Rotate; 

procedure Mark {The_Ring : in out Ring) is 
begin 

The_Ring - The.Jlark ; = The_Ring. The_Top ; 
end Hark; 

procedure Rotate_To_JM[ark (The_Ring : in out Ring) 
is 

begin 

The_Ring.The_Top The_Ring.The.Jlark; 

end Rotate_To__Hark; 

— modified by Tucui Nguyen 

— 10 January 1996 

— adding procedures to replace functions 

procedure Is_Equal (Left : in Ring; 

Right : in Ring; 

Result : out Boolean) is 

begin 

Result ;= l5_Equal(Left,Right); 
end Is_Ec 3 ual; 

procedure Extent_Of (The_Ring : in Ring; 

Result : out Natural) is 

begin 

Result := Extent_Of(The_Ring); 
end Extent_Of; 

procedure Is_Empty (The_Ring ; in Ring; 

Result : out Boolean) is 

begin 

Result Is_Eirpty(The_Ring) ; 
end Is_Empty; 

procedure Top_0f (The_Ring : in Ring; 

Result ; out Item) is 

begin 

Result Top_Of(The_Ring); 
end Top_0f; 

procedure At_Mark (The_Ring : in Ring; 

Result ; out Boolean) is 

begin 

Result := At_Mark(The__Ring) ; 
end At_Mark; 

— end of modification 
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function Is_Equal (Left : in Ring; 

Right ; in Ring) return Boolean 
is 

Left_Index : Structure := Left.The^Top; 
Right_Index : Structure := Right.The_Top; 
begin 

if Left_Index.The_Item /s Right_Index.The_Item 

then 

return False; 

elsif (Left.The_>lark = Left_Index) and then 
{Right.The_Mark /= Right_Index) then 
return False; 

else 

Left_Index := Left^Index.Next; 

Right_lndex := Right_Index.Next; 
while Left_lndex /= Left.The„Top loop 
if Left„Index.The_Item /- 
Right_Index.The_Item then 

return False; 

elsif {Left.The_Wark ^ Left_Index} and 

then 

(Right.The_Mark /= Rxght_Index) then 
return False; 

else 

Left^Index := Left_Index.Next; 
Right_Index := Right_Index.Next; 
end if; 
end loop; 

return (Right_Index = Right.The_Top); 
end if; 
exception 

when Constraint_Error => 

return (Left.The^Top = Right.The_Top); 
end Is_Equal; 

fiinction Extent^Of (The_Ring : in Ring) return 
Natural is 


Coxint : Natural := 0; 

Index : Structure := The_Ring.The^Top; 
begin 

Index := Index.Next; 

Count := Count + 1; 

while Index /= The_Ring.The_Top loop 
Count Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
exception 

when Constraint_Error => 
return 0; 
end Extent_Of; 

function Is_Eitpty (The_Ring : in Ring) return 
Boolean is 
begin 

return (The_Ring.The_Top = null); 
end Is_Ert 5 >ty; 

function Top_Of (The_Ring : in Ring) return Item is 
begin 

re turn The_Ring.The JTop.The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_Of; 

function At^JIark (The_Ring : in Ring) return 
Boolean is 
begin 

return (The_Ring.The_Top = The_Ring.The„Mark); 
end At_Mark; 

end Ring_Sequential_Unbounded_UninanagecLNoniterator; 
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RING SEQUENTIAL UNBOUNDED UNMAN AGED NONITERATOR 

PSDL 


TYPE Ring_Sequential_Unbounded^UninanagecLNoniterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Froin_The_Ring : Ring, 

To_The_Ring : Ring 
OUTPUT 

To_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_Item ; Item, 

In_The_Ring : Ring 
OUTPUT 

In_The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The^Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Rotate 
SPECIFICATION 
INPUT 

The_Ring : Ring, 

In_„The_Direction : Direction 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Mark 
SPECIFICATION 
INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 


OPERATOR Rotate_To^ark 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

The_Ring : Ring 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : Ring, 

Right : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The^Ring : Ring 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow, Rotate^Error 

END 

OPERATOR ls_En?)ty 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

OPERATOR At_Mark 

SPECIFICATION 

INPUT 

The_Ring : Ring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow, Rotate_Error 

END 

END 

IMPLEMENTATION ADA 

Ring_Sequen t i al_Unt>o\mded_UnmanagecLJJoni terat or 
END 
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SETS 0BJ3 SPECIFICATIONS 


obj SETtX :: TRIV] is sort Set . 
protecting NAT . 

*** constructors 


op create 
op copy 


Set 

-> Set 
Set “> Set 

op clear 


Set 

-> Set . 

op add 


Elt 

Set “> Set 

op remove 


Elt 

Set -> Set 

op union 

Set 

Set 

Set •“> Set 

op intersection 

Set 

Set 

Set -> Set 

op difference 

Set 

Set 

Set “> Set 

♦* accessors 

op isequal 

Set 

Set 

-> Bool . 

op extentof 


Set 

-> Nat . 

op isen^ty 


Set 

-> Bool . 

op isamember 

Elt 

Set 

-> Bool . 

op isasubset 

Set 

Set 

-> Bool . 

op isapropersubset 

Set 

Set 

-> Bool . 

** exceptions 

op overflow 

-> Set 


op itemisinset 

-> Set 


op itemisnotinset 

-> Set 



*** varicibles declaration 

var S SI S2 : Set . 
var E El : Elt . 

*** axioms 

eq copy(S,SI) = S . 


eq clear(S) = create . 

eq remove(E,create) itemisnotinset . 

eq remove(E,add(El,SI)) = if E == El then SI else 
add(El,remove(E,SI)) fi • 

eq union(S,create,SI) = S . . 

eq union(S,add(El,Sl),S2) = if isamember(El,S) then union(S,SI,S2) 
else add(El,union{S,Sl,S2)) fi , 

eq intersection{S,create,SI) = create . 

eq intersection{S,add(El,SI),S2) = if isamember(El,S) then 
add(El,intersection(S,SI,S2)) else intersection(S,SI,S2) fi • 

eq difference(create,S,SI) = S . 

eq difference(S,create,SI) = S . 

eq difference{S,add(El,SI),S2) = if isamember(El,S) then 
difference(remove(El,S),SI,S2) else add(El,difference(S,SI,S2)) fi . 

eq isequal(S,S1) » S == SI . 

eq extentof(create) = 0 . 

eq extentof(add{E,S)) = 1 + extentof(S) . 

eq isamember(E,create) = false . 

eq isamember(E,add(El,Si)) * E == El or isamember(E,SI) . 

eq isasubset(create,S) = true . 

eq isasubset(add(E,S),SI) = if isamember(E,SI) then 
isasubset(S,remove(E,SI)) else false fi . 

eq isapropersubset (S,S1) = isasiibset (S,S1) and extentof (SI) > 
extentof(S) . 

endo 
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SET PROFILE CODES 


OPERATORS 

SIGNATURES 

PROFILE CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

ADD 

AB->B 

3211 

REMOVE 

AB->B 

3211 

UNION 

ABC->C 

4231 

INTERSECTION 

ABC->C 

4231 

DIFFERENCE 

ABC->C 

4231 

IS.EQUAL 

AB->C 

330 

EXTENT_OF 

A->B 

220 

IS_EMPTY 

A->B 

220 

IS_A_MEMBER 

AB->C 

330 

IS_A_SUBSET 

AB->C 

330 

IS_A_PROPER_SUBSET 

AB->C 

330 


SET OF PROFILE: {4231,3211,2201,330,220} 
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SET SIMPLE SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

package Set_Sinple_Sequential_Bounded_Managed_Iterator is 


type Set{The_Size : Positive) is limited private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Add 

Remove 

Union 

Intersection 

Difference 


(FromJThe^Set 

To_The_Set 

(The_Set 

(The_Item 

To„The_Set 

(The_Item 

From_The_Set 

(Of_The_Set 

AndLThe^Set 

To_The_Set 

(Of_The_Set 

And_The_Set 

To_The_Set 

(Of_The_Set 

And_The_Set 

To_The_Set 


in 


Set; 

in 

out 

Set) 

in 

out 

Set) 

in 


Item 

in 

out 

Set) 

in 


Item 

in 

out 

Set) 

in 


Set; 

in 


Set; 

in 

out 

Set); 

in 


Set; 

in 


Set; 

in 

out 

Set); 

in 


Set; 

in 


Set; 

in 

out 

Set); 


— modified by Tuan Nguyen 

— 20 Aug 95 

— replacing ftmctions with procedures 


procedure Is_Equal 


procedure Extent_Of 
procedure Is_Empty 
procedure Is_JV_^ein)3®r 


(Left 

Right 

Result 

(The_Set 

Result 

(The^Set 

Result 

(The^Item 

Of_The_Set 

Result 


in Set; 
in Set; 
out Boolean); 
in Set; 
out Natural); 
in Set; 
out Boolean); 
in Item; 
in Set; 
out Boolean); 


procedure ls_A^Subset 
procedure Is_A-Proper_Subset 

end of modification 

function Is_Equal 

function Extent_Of 
function Is_Empty 
function Is_A_Merober 

fxjnction Is_A».Subset 

function Is_A_Proper_Subset 


(Left 

: in Set; 

Right 

: in Set; 

Result 

: out Boolean) 

(Left 

: in Set; 

Right 

; in Set; 

Result 

: out Boolean) 


(Left 

in 

Set; 



Right 

in 

Set) 

return 

Boolean; 

(The_Set 

in 

Set) 

return 

Natural 

(The_Set 

in 

Set) 

return 

Boolean; 

(The_Item 

in 

I tern; 



Of_The_Set 

in 

Set) 

return 

Boolean; 

(Left 

in 

Set; 



Right 

in 

Set) 

return 

Boolean; 

(Left 

in 

Set; 



Right 

in 

Set) 

return 

Boolean; 


generic 

with procedure Process (The_Item 
Continue 

procedure Iterate (Over_The_Set : in 


: in Item; 

: out Boolean); 
Set) ; 


Overflow : exception; 
IteiiuIs_In_Set : exception; 
IteituIs_Not_In_Set : exception; 


private 

type Items is array(Positive range <>) of Item; 
type Set(The_Size : Positive) is 
record 

The^Back ; Natural := 0; 

The_Iterns : Items (1 .. The_Size) ; 
end record; 

end Set_Simple_Sequential_Bo\mdecLKanaged_Iterator; 
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SET SIMPLE SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 
—All Rights Reserved 


— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in s\ibdivision {b) {3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Set_Siiiple_Sequential„Bounded_Managed_Iterator is 

procedure Copy (FroiiL.The_Set : in Set; 

To_The_Set : in out Set) is 

begin 

if FrorcL.The_Set.The_Back > To__The_Set.The_Size then 
raise Overflow; 

else 

To_The Set. The_Iterns (1 .. FronuThe_Set. The_Back) : = 
FrortL.The_Set -The^Items (1 . . FroiTL.The_Set.The_Back) ; 
To_The_Set.The_Back := From_The_Set.The_Back; 
end if; 
end Copy; 

procedure Clear (The_Set : in out Set) is 
begin 

The_Set.The_Back := 0; 
end Clear; 


procedure Add {The_Item : in Item; 

To_The_Set ; in out Set) is 

begin 

for Index in 1 .. To_The_Set.The_Back loop 

if The_Item = To_The_Set.The_Iterns(Index) then 
raise IteiiL-Is_In_Set; 
end if; 
end loop; 

To_The_Set.The_Iterns(To_The_Set.The_Back +1) := The_Item; 

To_TheIset.The_Back := To_The_Set.The_Back + 1; 
exception 

when Constraint_Error => 
raise Overflow; 

end Add; 


And_Index : Natural; 
begin 

To_The_Set.The_Back := 0; 

for Of_Index in 1 .. Of_The_Set.The_Back loop 
AndLIndex ;= And_The_Set .'nie_Back; 
while AndLIndex > 0 loop 

if Of_The_Set.The_Iterns(Of^Index) = 

AncLThe_Se t. The_I t ems (And_Index) then 
To_The.„Set.The_Iteins{To_The_Set.The_Back + 1) 
Of_The_Set .The_Iterns (Of_Index) ; 

To_The_Set .The^Back := To_The_Set. The_Back + 1 
exit; 

else 

AndLIndex := AndLIndex - 1; 
end if; 
end loop; 
end loop; 
exception 

when Constraint_Error *:> 
raise Overflow; 
end Intersection; 

procedure Difference (Of_The_Set : in Set; 

AndLThe_Set : in Set; 

To_The_Set : in out Set) is 

AndLIndex : Natural; 
begin 

To_The_Set.The_Back := 0; 

for Of_Index in 1 .. Of_The_Set.The_Back loop 
AndLIndex := AndLThe_Set .The_Back; 
while AndLIndex > 0 loop 

if Of_The_Set,The_Items(Of_Index) = 

AntL-The^Se t. The_I terns {And_Index) then 
exit; 

else 

AndLIndex := AndLIndex - 1; 
end if; 
end loop; 

if AndLIndex = 0 then 

To_The_Set.The_Iteins(To_The_Set.The_Back + 1) 
Of_The_Set.The_Iteins(Of_Index) ; 

To_The_Set .The_Back := To_The_Set. The^Back + 1; 
end if; 
end loop; 
exception 

when Constraint„Error => 
raise Overflow; 
end Difference; 


procedure Remove (The__Item ; in Item; 

From_The_Set : in out Set) is 

begin 

for Index in 1 .. From_The_Set.The_Back loop 

if The_Item = From_The_Set.The_Iterns(Index) then 

FronuThe_Set.The_Items( Index .. (FronL_The_Set .The_Back 

- D) : = 

FronL.The_Set.The_ltems((Index + 1) .. 

From_The_Set, The_Back); 

FronuThe_Set.The_Back := Fronu.The_Set,The_Back - 1; 
return; 
end if; 
end loop; 

raise Item_Is_Not_InuSet; 
end Remove; 


procedure Union {Of_The_Set : in Set; 

And_,The_Set: in Set; 

To_The_Set : in out Set) is 

Natural; 

Natural; 


To^Index 
To^ack 
begin 

To_The_Set.The_Iterns{1 


Of_The_Set.The_Back) := 


Of_The_Set. The^Items (1 .. Of_The_Set. The_Back) ; 
To_The_Set.The_Back := Of_The_Set.The_Back; 
To_Back To_The_Set .The_Back; 

for And_Index in 1 .. And_The__Set .The_Back loop 
To^Index := To^Back; 
while To_Index > 0 loop 

if To_The_Set.The_Items{To_Index) = 

And_The_Set.The_Iteins (AndLIndex) then 
exit; 


else 

To_Index := To_Index - 1; 
end if; 
end loop; 

if To_Index = 0 then 

To_The_Set.The_Items(To_The_Set.The_Back + 
^d„The_Set.The_Iterns (AndLIndex) ; 
To_The„Set.The_Back := To_The_Set.The_Back 
end if; 
end loop; 
exception 

when Constraint_Error ss> 
raise Overflow; 
end Union; 


1 ) : = 
+ 1 ; 


modified by Tucin Nguyen 
20 Aug 95 

replacing functions with procedures 


procedure Is^Equal (Left 

Right 
Result 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Set 

Result 

begin 

Result := Extent_Of(The_Set); 
end Extent_Of; 


in Set; 
in Set; 

out Boolean) is 


in Set; 

out Natural) is 


procedure Is_Eir?3ty {The_Set 

Result 

begin 

Result := Is_Enpty(The_Set); 
end Is^Empty; 


in Set; 
out Boolean) 


procedure Is_AwMember 


(The_Item ; in Item; 
Of_The_Set : in Set; 

Result : out Boolean) is 

begin 

Result := Is_A_Member(The_Itern,Of_The_Set); 
end Is..AJMember; 


procedure Is^_Subset (Left 

Right 
Result 

begin 

Result := Is_A„Subset (Left,Right) ; 
end Is_A_Subset; 


in Set; 
in Set; 

out Boolean) is 


procedure Is_A_Proper_Subset (Left : in Set; 

Right : in Set; 

Result : out Boolean) is 

begin 

Result := Is_J^Proper_Subset (Left,Right) ; 
end Is_A_Proper_Subset; 

end of modification 


procedure Intersection (Of_The__Set : in Set; 

AndLThe^Set : in Set; 

To_The_Set : in out Set) is 


function Is_Equal (Left 
Right 


in Set; 

in Set) return Boolean is 
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Right_Index : Natural; 
begin 

if Left.The_Back /= Right.The^Back then 
return False; 

else 

for Left_Index in 1 .. Left.The^Back loop 
Right^Index := Right.The_Back; 
while Right_Index > 0 loop 

if Left.The_Items(Left_Index) = 

Right.The_Iterns(Right_Index) then 
exit ; 

else 

Right^Index := Right_Index - 1; 
end if; 
end loop; 

if Right_,Index = 0 then 
return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 

function Extent_Of (The_Set : in Set) return Natural is 
begin 

re turn The_Se t.The_Back; 
end Extent_Of; 

function Is^Enpty (The^Set : in Set) return Boolean is 
begin 

return (The_Set.The^Back =0); 
end Is^Enpty; 

f\inction Is_A^einber (The_Itein : in Item; 

Of_The_Set : in Set) return Boolean is 

begin 

for Index in 1 .. Of_The_Set.The_Back loop 

if Of_The_Set.The_Iteros{Index) = The_Item then 
return True; 
end if; 
end loop; 
return False; 
end Is_AJdember; 

function Is^?L.S\abset (Left : in Set; 

Right : in Set) return Boolean is 
Right_Index : Natural; 
begin 


for Left_Index in 1 .. Left.The_Back loop 
Right_Index := Right.The_Back; 
while Right_Index > 0 loop 

if Left.The_Itenis(Left_Index) = 

Right.The_Iterns(Right_Index) then 
exit ; 

else 

Riglit_Index ;= Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 
end if; 
end loop; 
return True; 
end Is_A_Subset; 

function Is_Av_Proper_S\abset (Left : in Set; 

Right : in Set) return Boolean is 

Right_Index : Natural; 
begin 

for Left_Index in 1 .. Left.The^Back loop 
Right_Index := Right.The_Back; 
while Right_Index > 0 loop 

if Left,The_Items(Left_Index) = 

Right. The_I terns (Ri ght_lndex) then 
exit; 

else 

Right_Index := Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 
end if; 
end loop; 

return (Left.The_Back < Right.The_Back); 
end Is_A„Proper_Subset; 

procedure Iterate {Ov€r_The_Set : in Set) is 
Continue ; Boolean; 
begin 

for The_Iterator in 1 . . Over_The_Set .The_Back loop 

Process(Over_The_Set.The_Items(The_Iterator), Continue) 
exit when not Continue; 
end loop; 
end Iterate; 

end Set_Siirple_Sequential^ounded_Managed_Iterator; 
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SET SIMPLE SEQUENTIAL BOUNDED MANAGED ITERATOR 

PSDL 


TYPE Set_Sin?)le_Sequential_Bounde<iJianaged^Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronL.The_Set : Set, 

To_The_Set ; Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, IteirL.Is_In_Set, ltenL,Is_Not_In_Set 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Set : Set 
OUTPUT 

The_Set : Set 
EXCEPTIONS 

Overflow, ItenuIs_In_Set, ItenuIs_Not_Ii;_Set 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item ; Item, 

To_'rtie_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, IteiiL.Is_In_Set, IteituIs_Not_Iii>_Set 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The_Item : Item, 

Fron\_The_Set : Set 
OOTPUT 

FronL.The_Set : Set 
EXCEPTIONS 

Overflow, Iteit\_Is_IrL-Set, Item_Is_Not_In_Set 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of__The_Set : Set, 

And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In„Set, ItenL.ls_Not_In_Set 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 

And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set ; Set 
EXCEPTIONS 

Overflow, Itein_Is_In_Set, Item_IsJNot_In_Set 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 

And^The_Set : Set, 

To_The_Set ; Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_IsJJot_IiuSet 


END 

OPERATOR Is^Equal 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Iten\_Is„In„Set, Iten\_Is_^Jot_In_Set 

END 

OPERATOR Extent^Of 

SPECIFICATION 

INPUT 

The_Set : Set 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, lteiiuIs_In_Set, Iten\_Is_Not_In_Set 

END 

OPERATOR Is_En?)ty 

SPECIFICATION 

INPUT 

The_Set : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, IteirL.Is_In_Set, Item_Is_Not_ln_Set 

END 

OPERATOR Is^AwNeniber 

SPECIFICATION 

INPUT 

The_Item : Item, 

Of_The_Set : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item^Is_In_Set, IteiruIs_Not_In„Set 

END 

OPERATOR IS^Subset 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItenuIs_In„Set, Item_Is_Not_In_Set 

END 


OPERATOR Is_A-Proper_Subset 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, IteiruIs_ln_Set, Item_IsJJot_In_Set 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : intt ; Item], Continue : out[t 
Boolean]] 

INPUT 

Over_The_Set : Set 
EXCEPTIONS 

Overflow, IteituIs_In_Set, Item_Is_Not_In_Set 

END 

END 

IMPLEMENTATION ADA Set_Si»5>le_Sequential_Bounded^anaged_Iterator 
END 
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SET SIMPLE SEQUENTIAL BOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Set_Siitple_Sequential_Bo\mded_Managed_Noniterator is 
type Set(The_Size : Positive) is limited private; 


procedure 

Copy 

(From_The_Set 

in 


Set; 


To_The_Set 

in 

out 

Set) ; 

procedure 

Clear 

(The_Set 

in 

out 

Set); 

procedure 

Add 

(The_Item 

in 


I tern; 


To_The_Set 

in 

out 

Set) ; 

procedure 

Remove 

(The_Item 

in 


Item; 


Fr om_The_Se t 

in 

out 

Set) ; 

procedure 

Union 

(Of_The_Set 

in 


Set; 


And_The_Set 

in 


Set; 



To_The_Set 

in 

out 

Set) ; 

procedure 

Intersection 

{Of_The_Set 

in 


Set; 


And_The_Set 

in 


Set; 



To_The_Set 

in 

out 

Set) ; 

procedure 

Difference 

(Of_The_Set 

in 


Set; 


And_The_Set 

in 


Set; 



To_The_Set 

in 

out 

Set) ; 

modified by Tucin Nguyen 





20 Aug 95 






replacing 

fiinctions with procedures 




procedure 

Is_Equal 

(Left 


in 

Set; 


Right 


in 

Set; 



Result 


out Boolean) 

procedure 

Extent_Of 

(The^Set 


in 

Set; 


Result 


out Natural) 

procedure 

Is_En 5 >ty 

(The_Set 


in 

Set; 

Result 


out Boolean) 


procedure Is,J01®niber 

{The„Item 

; in Item; 

Of_The_Set 

: in Set; 


Result 

: out Boolean); 

procedure Is^A^Subset 

(Left 

; in Set; 


Right 

: in Set; 


Result 

; out Boolean); 

procedure Is^A^Proper_Subset 

(Left 

: in Set; 

Right 

; in Set; 


Result 

: out Boolean); 

end of modification 

function Is_Equal 

(Left : 

in Set; 

Right : 

in Set) return Boolean 

function Extent_Of 

(The^Set : 

in Set) return Natural 

function Is_Ett?jty 

(The^Set : 

in Set) return Boolean 

function Is_A^eniber 

(The_Item : 

in Item; 

Of_The„Set : 

in Set) return Boolecin 

function Is_^Subset 

(Left : 

in Set; 


Right : 

in Set) return Boolean 

f\mction Is_A_Proper_Subset 

(Left : 

in Set; 

Right : 

in Set) return Boolean 

Overflow : exception; 



Itern_Is_In_Set : exception; 

Item_IsJNot_In_Set : exception; 

private 

type Items is array(Positive range <>) of Item; 
type Set(The_Size : Positive) is 
record 

The^Back : Natural ;= 0; 

The_Iterns : Items{1 .. The_Size); 
end record; 

end Set_Siinple_Sequential_Boundecijaanaged_Noniterator; 
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SET SIMPLE SEQUENTIAL BOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 


— Serial Kximber 0100219 

"Restricted Rights Legend" 

Use, duplication, or disclosure is subject to 

— restrictions as set forth in sxabdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Set_Siinple_Sequential_Bounded.JlanagedJNoniterator is 

procedure Copy (FronL_The_Set : in Set; 

To_The_Set : in out Set) is 

begin 

if FronuThe_Set.The_Back > To_The_Set.The_Size then 
raise Overflow; 

else 

To_The_Set.The_ltems(l .. FronuThe_Set.The_Back) : = 
FronuThe^Set. The_Iterns (1 -. FronL-The^Se t. The_Back) ; 
To_The_Set.The_Back := FronL_The_Set.The_Back; 
end if; 
end Copy; 

procedure Clear (The_Set : in out Set) is 
begin 

The_Set.The_Back ;= 0; 
end Clear; 


procedure Add (The^Item : in Itern; 

To_The_Set : in out Set) is 

begin 

for Index in 1 .. To_The_Set.The_Back loop 

if The_Itein ss To_The_Set.The_Iterns (Index) then 
raise IteiiuIs_ln^Set; 
end if; 
end loop; 

To_The_Set.The_Iterns{To_The_Set.The_Back +1) := The_Item; 

To_The_Set.The_Back ;= To_The_Set.TheJBack + 1; 
exception 

when Constraint^Error ®> 
raise Overflow; 

end Add; 


procedure Remove (The_Item : in Itern; 

From_The„Set : in out Set) is 

begin 

for Index in 1 .. FronuThe_Set .The_Back loop 

if The_Item = FroiiuThe_Set.The_Iterns (Index) then 

From_The_Se t. The_I terns (Index .. (FroxtuThe_Set. The_Back 

- D) : = 

From_The_Set.The^Iterns((Index +1) .. 

Froin_The_Set.The_Back) ; 

Froiii_The_Set .The_Back ;= From_The_Set .The_Back - 1; 
return; 
end if; 
end loop; 

raise Itein_Is_Mot_In_Set; 
end Remove; 


procedure Union (Of_The_Set : in Set; 

AncL.The_Set: in Set; 

To_The_Set : in out Set) is 

To_Index ; Natural; 

To_Back : Natural; 
begin 

To_The_Set.The_Iterns(1 .. Of_The_Set.The_Back) := 
Of_The_Set .The_Items (1 .. Of_The_Set .The^ack); 
To_The_Set.The_Back Of_The_Set,The_Back; 
To_Back := To_The_Set.The^Back; 
for And_Index in 1 .. And_The_Set .The_Back loop 
To_Index := To_Back; 
while To_Index > 0 loop 

if To_The_Set.The_Items(To_Index) * 

AndLThe_Set. The_I terns (And_Index) then 
exit; 


else 

To^Index := To_Index - 1; 
end if; 
end loop; 

if To^Index = 0 then 

To_The_Set.The_Items(To_The_Set.The_Back +1) ; = 

AncLThe_Set .The_lterns (And_lndex); 
To_The_Set.The_Back := To_The_Set.The_Back + l; 
end if; 
end loop; 
exception 

when Constraint_Error => 
raise Overflow; 
end Union; 


procedure Intersection (Of_The_Set : in Set; 

And_The_Set ; in Set; 

To_The_Set : in out Set) is 


And_Index : Natural; 
begin 

To_The_Set.The_Back := 0; 

for Of_Index in 1 .. Of_The_Set.The_Back loop 
AndLIndex := And^The_Set .The_Back; 
while AndLIndex > 0 loop 

i f 0 f_The_Se t. The_I terns (Of_Index) = 

And_The_Set.The^Items(AndLIndex) then 
To_The„Set.The_Iterns(To_The_Set.The_Back + 1) 
Of JThe^Set. The_Iterns (Of_Index) ; 

To_The_Set.The_Back := To_The_Set.The_Back + l 
exit; 

else 

AndLIndex := AndLIndex - 1; 
end if; 
end loop; 
end loop; 
exception 

when Constraint_Error => 
raise Overflow; 
end Intersection; 

procedure Difference {Of_The_Set ; in Set; 

And_The_Set : in Set; 

To_The_Set ; in out Set) is 

AndLIndex ; Natural; 
begin 

To_The_Set.The_Back := 0; 

for Of_Index in 1 .. Of_The_Set.The_Back loop 
AndLIndex := AndLThe_Set.The_Back; 
while And_lndex > 0 loop 

if Of_The_Set.The_Iterns(Of_Index) = 

AndLThe_Se t. The_I terns (AndLIndex) then 
exit; 

else 

AndLIndex := And_Index - 1; 
end if; 
end loop; 

if AndLIndex = 0 then 

To_The_Set.The_Items(To_The_Set.The_Back +1) := 

0 f_The_Se t. The_I terns (0 f_Index) ; 
To_The_Set.The_Back := To_The_Set.The_Back + 1; 
end if; 
end loop; 
exception 

when Cons traint_.Error => 
raise Overflow; 
end Difference; 

modified by Tuan Nguyen 
20 Aug 95 

replacing f^anctions with procedures 


procedure Is_Equal (Left 

Right 
Result 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Set 

Result 

begin 

Result := Extent_Of(The_Set); 
end Extent^Of; 

procedure Is_Ernpty (The_Set 

Result 

begin 

Result ;= Is^Empty(The_Set); 
end Is_Ertpty; 


in Set; 
in Set; 

out Boolean) is 


in Set; 

out Natural) is 


in Set; 

out Boolean) is 


procedure Is^A-^lember (The_Item : in Item; 

Ofjrhe_Set : in Set; 

Result : out Boolean) is 

begin 

Result := Is_A_Member(The_Itern,Of_The_Set); 
end Is_A_Member; 


procedure Is^_S\ibset (Left 

Right 
Result 

begin 

Result ;= Is_A.^Subset (Left,Right); 
end Is_A_Subset; 


in Set; 
in Set; 

out Boolean) is 


procedure Is_A_Pi‘opei^-.Subset 


(Left 

Right 

Result 


in Set; 
in Set; 
out Boolean) 


begin 

Result : = Is.JL.Proper_Subset (Left, Right); 
end Is_A^Proper_Subset ; 


is 


end of modification 


function Is_Equal (Left 
Right 


in Set; 

in Set) return Boolean is 
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Right^Index : Natural; 
begin 

if Left.The^Back /= Right.The_Back then 
return False; 

else 

for Left_lndex in 1 .. Left.The_Back loop 
Right_Index := Right,The_Back; 
while Right^Index > 0 loop 

if Left.The_Iterns(Left_Index) = 

Right.The_Iterns(Right_Index) then 
exit ; 

else 

Right_Index := Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 

function Extent_Of {The_Set : in Set) return Natural is 
begin 

return The_Se t.The_Back; 
end Extent_Of; 

function Is_Empty (The^Set ; in Set) return Boolean is 
begin 

return (The_Set.The_Back = 0); 
end Is_En 5 )ty; 

function Is^AJlember (The_Itein : in Item; 

Of_The_Set : in Set) return Boolean is 

begin 

for Index in 1 .. Of_The_Set.The_Back loop 

if Of_The_Set-The_Iterns (Index) = The_Item then 
return True; 
end if; 
end loop; 
return False; 
end Is.AJMeinber; 


function Is_A_Subset (Left : in Set; 

Right : in Set) return Boolean is 
Right_Index : Natural; 
begin 

for Left^Index in 1 .. Left.The_Back loop 
Right_Index := Right.The_Back; 
while Right^Index > 0 loop 

if Left.The_Iteins{Left_Index) = 

Right.The_Iterns(Right_Index) then 
exit; 

else 

Right_Index := Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 
end if; 
end loop; 
return True; 
end Is^_Subset; 

function Is_A_Pi^oper_Subset (Left : in Set; 

Right : in Set) return Boolean is 

Right_Index : Natural; 
begin 

for Left_Index in 1 -• Left.The_Back loop 
Right_Index := Right,The_Back; 
while Right_Index > 0 loop 

if Left.The_Items(Left_Index) = 

Right.The_Iterns(Right_Index) then 
exit; 

else 

Right^Index := Right_Index - 1; 
end if; 
end loop; 

if Right_Index = 0 then 
return False; 
end if; 
end loop; 

return (Left.The_Back < Right.The_Back); 
end Is_A-.Proper_Subset; 

end Set_Simple_Sequential_Bounded_>!anaged_Noniterator; 
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SET SIMPLE SEQUENTIAL BOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Set_Sin?}le_Sequential_BoundecLManagedJJoni terator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPtJT 

FrortuThe_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, IteiiuIs_In_Set, IteituIsjNot_In_Set 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Set : Set 
OUTPUT 

The_Set : Set 
EXCEPTIONS 

Overflow, Iteiruls_In_Set, ItenuIs_Not_In_Set 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item ; Item, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Iteia_Is_In_Set, IteituIs_Not_In_Set 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The_Item ; Item, 

FronuThe_Set ; Set 
OUTPUT 

Fronu‘I^e_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, IteiruIs_Not_In_Set 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 

And_The_Set : Set, 

To_The_Set ; Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_ls_ln_Set, IteiiuIs_Not_In_Set 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 

And_The_Set ; Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Itenu,IsJNot_In_Set 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 


And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, ItenuIs_In_Set, ItenL.Is_Not In_Set 

END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, IteitL.Is_In_Set, Item_Is_Not_In_Set 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The^Set : Set 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, Item_ls_In_Set, Item_Is_Not_In_Set 

END 

OPERATOR Is_^En5)ty 

SPECIFICATION 

INPUT 

The_Set ; Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItenuIS-In_Set, Iten\_Is_Not_In_Set 

END 


OPERATOR Is_AJ4ember 

SPECIFICATION 

INPUT 

The^Item : Item, 

Of_The_Set : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_ls_In_Set, Item_lsJNot_in_Set 

END 

OPERATOR Is^A^Subset 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItetruIs_In_Set, IteiruIs_Not„ln_Set 

END 

OPERATOR Is_A_Proper_Subset 

SPECIFICATION 

INPUT 

Left ; Set, 

Right ; Set 
OUTPOT 

Result : Boolean 
EXCEPTIONS 

Overflow, lteiiuIs_In_Set, Item_lsJNot_In_Set 

END 

END 

IMPLEMENTATION ADA Set_Simple_Sequential_Bounded_Managed_Noniterator 
END 
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SET SIMPLE SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

packaS^SeSi^lSe^intial_UnboundedJIanaged_Iterator is 
type Set is limited private; 


procedure Copy 

procedure Clear 
procedure Add 

procedure Remove 

procedure Union 


procedure Intersection 


procedure Difference 


(FronuThe_Set 
To_The_Set 
(The^Set 
(The_Item 
To_The_Set 
(The_Item 
Fr on\_The_Se t 
(Of_The_Set 
And_The_Set 
To_The_Set 
(Of_The_Set 
And_The_Set 
To_The_Set 
(Of_The_Set 
And^The_Set 
To_The_Set 


— modified by Tuan Nguyen 

— 20 Aug 95 , 

— replacing fjunctions with procedures 


procedure Is^Equal 

procedure Extent^Of 
procedure Is_Empty 
procedure is^A-Nember 


(Left 

Right 

Result 

(The_Set 

Result 

{The_Set 

Result 


: in Set; 

: in Set; 

: out Boolean); 
; in Set; 

: out Natural); 
: in Set; 

: out Boolean); 


Of_The_Set 

Result 

procedure Is^_Subset (Left 

Rrght 
Result 

procedure ls_A^Proper_Subset (Left 


— end of modification 

function Is^Equal 

function Extent_Of 
function Is_Errpty 
function Is^Member 

function ls_A-.Subset 

function Is_A_Proper_SubS€t 


(Left 

Right 

(The_Set 

(The_Set 

(The_Item 

Of_The_Set 

(Left 

Right 

(Left 

Right 


in Set; 
out Boolean); 
in Set; 
in Set; 
out Boolean); 
in Set; 
in Set; 
out Boolean); 


in Set; 
in Set) 
in Set) 
in Set) 
in Item; 
in Set) 
in Set; 
in Set) 
in Set; 
in Set) 


return Boolean; 
return Natural; 
return Boolean; 

return Boolean; 

return Boolean; 

return Boolean; 


^ with procedure Process (The_Item : in Item; 

Continue : out Boolean); 
procedure Iterate {Over_The_Set : in Set); 

Overflow : exception; 

ItenuIs_In_Set : exception; 

IteiiuIs_Not_In_Set : exception; 

private 

type Node; 

type Set is access Node; 

end Set_Sitnple_Sequential_Unbounded_Managed_I terator; 
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SET SIMPLE SEQUENTIAL UNBOUNDED MANAGED ITERATOR 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3} (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage.Jlanager_Sequential; 

package body Set_Sin5>le_Sequential_Unbounded_ManagedLIterator is 

type Node is 
record 

The_Item : Item; 

Next : Set; 
end record; 

procedure Free (The_Node : in out Node) is 
begin 

null; 
end Free; 

procedure SetJNext (TheJTode : in out Node; 

ToJWext : in Set) is 

begin 

TheJMode.Next : = To_Next; 
end Set_^ext; 

function Next_Of (TheJNode : in Node) return Set is 
begin 

return The^ode.Next; 
end Next_Of; 

package Node_Manager is new Storage_Jlanager_Sequential 

(Item => Node, 

Pointer => Set, 

Free -> Free, 

Set_Pointer ==> Set_Next, 
Pointer^Of => Next_Of); 

procedure Copy (FrorruThe^Set : in Set; 

To_The_Set : in out Set) is 
Frooulndex : Set := From_The_Set; 

To^Index : Set; 
begin 

NodeJManager.Free(To_The_Set); 
if From_The_Set /== null then 

To_The_Set := Node_Manager.New_Item; 

To_The_Set.The_Item ;= Froituindex.The_Itern; 

To^Index := To_The_Set; 

Fronulndex : = Fronuindex. Next ; 
while From_Index /- null loop 

To_Index.Next := NodeJManager.New_Item; 

To_.Index := To_Index.Next; 

To_Index.The_Item := From_Index.The_Item; 
From_Index := From^Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The^Set : in out Set) is 
begin 

Node_Manager. Free (The_Set) ; 
end Clear; 

procedure Add (The_Item : in Itern; 

To_The_Set : in out Set) is 
TenqporaryJMode : Set; 

Index : Set := To_The„Set; 

begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 
raise Item_Is_In_Set; 

else 

Index ;= Index.Next; 
end if; 
end loop; 

Temporary JMode := NodeJManager .New_I tern; 

TenporaryJIode .The_Item := The_Item; 

Tenporaxry^Node. Next : = To„The_Set ; 

Tojrhe_Set Tenporary^Node; 
exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Remove (The_ltem : in Itern; 

From_The_Set : in out Set) is 
Previous : Set; 


Index : Set ;= FronuThe^Set; 
begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 
if Previous = null then 

FroirL_The_Se t : = FronuThe_Set. Next ; 

else 

Previous.Next ;= Index.Next; 
end if; 

Index.Next ;= nul1; 

NodeJlanager. Free {Index) ; 
return; 

else 

Previous := Index; 

Index := Index,Next; 
end if; 
end loop; 

raise IteiA_Is_Not_In_Set; 
end Remove; 

procedure Union {Of_The_Set : in Set; 

Anc3LThe_Set: in Set; 

To_The_Set : in out Set) is 

Fronjlndex : Set := Of_The_Set; 

To_Index : Set; 

To^Top : Set; 

Tenporary_^ode : Set; 

begin 

Node_Manager.Free{To_The_Set); 
while From_Index /= null loop 

Teinporary_JJode := Node_Maiiager.New_Item; 
Tenporary_Node.The_Item ;= From_Index.The_Item; 
Tenporary_Node. Next : = To_The_Se t ; 

To_The_Set : = Tenporary_jJode; 

From_Index := FronjIndex.Next; 
end loop; 

FroDL-Index : = And_The_Set; 

To_Top := To_The_Set; 
while From_Index /= null loop 
To_Index To_Top; 
while To_Index /= null loop 

if FronuIndex.The_Item * To_Index.The_Item then 
exit ; 

else 

To_Index : = To^Index.Next; 
end if; 
end loop; 

if To_Index = null then 

Tenporary__Node ;= Node_Manager.New_Item; 
Teirporary_Node .The^Item ;= From_Index.The_Item; 
Teaporary^Node.Next := To_The_Set; 

To_The_Set := Tenpor ary JMode ; 
end if; 

Frortuindex ;= Froin_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Union; 

procedure Intersection (Of_The_Set : in Set; 

And_The_Set : in Set; 

To_The„Set : in out Set) is 

Of_Index ; Set := Of_The_Set; 

And_Index : Set; 

Tenporary JMode ; Set; 
begin 

NodeJManager. Free (To_ThejSet); 
while OfjIndex /= null loop 
And_Index ;= AncJThejSet; 
while Andjlndex i~ null loop 

if Of_Index.The_Item = AncLIndex,The_Itein then 
Temporary^Node := Node_Manager .New^Item; 
Tenporaryj,Node.The_ltem := OfjIndex.ThejItem; 
TenporaryjNode.Next := TOjThejSet; 

To_The_Set := Tenporary_Node; 
exit; 

else 

Andjlndex := AndjIndex.Next; 
end if; 
end loop; 

Ofjindex := OfjIndex.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Intersection; 

procedure Difference {Of_ThejSet ; in Set; 

AnoLThe_Set : in Set; 

To_The_Set : in out Set) is 

Ofjindex : Set := OfjThe_Set; 

And-Index : Set; 

Temporary JMode : Set; 

begin 

Node_Manager.Free(TojThe_Set); 
while Of_Index /= null loop 
Andjindex := And^The^Set; 
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while And^Index /* null loop 

if Of_Index.The_Item = And_Index.The_Iteni then 
exit; 

else 

And_Index := And_Index.Next 
end if; 
end loop; 

if AncLIndex = null then 

Tenporary^Node := Node_Manager.New_Item; 
Ten?3orary_Node.The_Item := Of_Index.The_Iteiti; 
Temperary_Node.Next := To_The_Set; 

To_The_Set := TenporaryJNode; 
end if; 

Of^Index := Of_Index.Next; 
end loop; 
exception 

when storage_Error => 
raise Overflow; 
end Difference; 

modified by Tuan Nguyen 
20 Aug 95 

replacing functions with procedures 


procedure Is^Equal (Left 

Right 
Result 

begin 

Result := Is^Equal(Left,Right); 
end Is^Equal; 

procedure Extent_0f (The_Set 

Result 

begin 

Result := Extent^Of(The^Set); 
end Extent_Of; 

procedure Is_Empty (The^Set 

Result 

begin 

Result := Is_Eropty(The_Set); 
end Is^Empty; 


procedure Extent_0f 


procedure Is_Empty 


in Set; 
in Set; 

out Booleeui) is 


in Set; 

out Natural) is 


in Set; 

out Boolean) is 


procedure Is_A^ember (The_ltem : in I 

Of_The_Set : in S 
Result : out 

begin 

Result : = Is.J^Meniber {The_Item, Of_The_Set) ; 
end Is^_N€rnber; 


in I tern; 
in Set; 

out Boolean) is 


procedure Is^^Subset (Left 

Right 
Result 

begin 

Result ;= ls_A_Subset(Left,Right); 
end Is_A„Subset; 


: in Set; 

; in Set; 

: out Boolean) is 


procedure Is.,„AwP^®P®^—(Left : in 

Right : in 

Result : ovi 

begin 

Result ;= Is,JUProper_Subset (Left,Right) ; 
end Is_A^Proper_Subset; 

end of modification 


in Set; 
in Set; 

out Boolean) is 


function Is_Equal (Left : in Set; 

Right ; in Set) return Boolean is 
Left_Count : Natural := 0; 

Right_Count : Natural := 0; 

Left_Index : Set := Left; 

Right_Index : Set; 
begin 

while L€ft_Index J- null loop 
Right_Index := Right; 
while Right^Index /= null loop 

if Left_Index,The_Item = Right_Index,The_Item then 
exit ; 

else 

Right^Index := Right_Index.Next; 
end if; 
end loop; 

if Right^Index = null then 
return False; 

else 

Left_Count := Left_Count + 1; 

Left_Index := Left_Index,Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right_Index /= null loop 

Right_Count := Right^Count + 1; 

Right_Index ;= Right^Index.Next; 
end loop; 

return (Left^Count = Right_Coiint) ; 
end ls_Egual; 


function Extent^Of (The^Set : in Set) return Natural is 
Count : Natural := 0; 

Index : Set := The^Set; 

begin 

while Index /= null loop 
Count := Count + 1; 

Index ;= Index.Next; 
end loop; 
return Count; 
end Extent_Of; 

function Is_Eir?Jty (The^Set : in Set) return Boolean is 
begin 

return (The_Set = null); 
end Is_En)pty; 

function Is_A_Member (The_Item : in I tern; 

Of_The_Set : in Set) return Boolean is 
Index : Set Of_The_Set; 
begin 

while Index /= null loop 

if The^Item = Index.The.Item then 
return True; 
end if; 

Index := Index.Next; 
end loop; 
return False; 
end Is_AJIe»ber; 

function Is^Subset (Left : in Set; 

Right : in Set) return Boolean as 
Left^Index : Set := Left; 

Right^Index : Set; 
begin 

while Left_Index /= null loop 
Right^Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right_Index := Right_Index-Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

else 

Left_Index := Left_Index.Next; 
end if; 
end loop; 
return True; 
end Is,^A-.Subset; 


ftanction Is_A_Proper_Subset 


(Left : in Set; 

Right : in Set) return Boolean is 


Left_Count : Natural := 0; 

Right^Count : Natural := 0; 

Left_Index : Set := Left; 

Right_Index : Set; 

begin 

while Left_Index /= null loop 
Right_Index ;= Right; 
while Right_lndex {- null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 


else 

Right_lndex := Right_Index.Next; 
end if; 


end loop; 

if Right_Index - null then 
return False; 


else 

Left_Count := Left_Coxant + 1; 
Left_Index := Left_Index.Next; 


end if; 


end loop; 

Right_Index ;= Right; 

while Right_Index /= null loop 

Right_Count ;= Right_Count 1; 
Right^Index := Right_Index.Next; 
end loop; 

return (Left_Count < Right_Count); 
end Is_A^Proper_Subset; 


procedure Iterate {Over_The_Set : in Set) is 
The^Iterator : Set := Over„The_Set; 

Continue : Boolean; 

begin 

while The^Iterator /= null loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The_Iterator ;= The_Iterator.Next; 
end loop; 
end Iterate; 


end Set_Siirple_Sequential_Unbovinded_JManaged_lterator; 
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SET SIMPLE SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

PSDL 


TOPE Set_Siii5)le_Se<5uential_UnboiandecLflanage(3LIterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TOPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_ls_JJot_In_Set 

END 


OPERATOR Clear 

SPECIFICATION 

INPUT 

The^Set : Set 
OUTPUT 

The^Set : Set 
EXCEPTIONS 

Overflow, Itenuls_ln_Set, ItertulsJJot__In_Set 

END 

OPERATOR Add 

SPECIFICATION 

INPUT 

The_Itein : Item, 

To_The_Set : Set 
OUTPUT 

To_The_Set ; Set 
EXCEPTIONS 

Overflow, Iteit\^Is_In_Set, IterrL.Is^Not_In_Set 

END 

OPERATOR Remove 

SPECIFICATION 

INPUT 

The_Item : Item, 

FronuThe^Set : Set 
OUTPUT 

FrorruThe_Set : Set 
EXCEPTIONS 

Overflow, IteitL.Is_In_Set, Iteit\_Is_Not_In_Set 

END 

OPERATOR Union 

SPECIFICATION 

INPUT 

Of_The_Set : Set, 

AncLThe_Set : Set, 

To_The_Set ; Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item(_Is„In_Set, Iteit\_Is_Not_In_Set 

END 

OPERATOR Intersection 

SPECIFICATION 

INPUT 

Of_The_Set : Set, 

And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Iteit^_Is_JNot_In_Set 

END 

OPERATOR Difference 

SPECIFICATION 

INPUT 

Of_The_Set : Set, 

And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, ItertuIs_In_Set, IteIt^_Is_Not_ln_Set 


END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left ; Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_IsJIot_In_Set 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Set : Set 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, ItenL.Is_In_Set, ItenuIsJNot_In_Set 

END 

OPERATOR IS_Enipty 

SPECIFICATION 

INPUT 

The_Set : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Iten\_Is_Not_In_Set 

END 


OPERATOR Is_A-Member 

SPECIFICATION 

INPUT 

The_Item : Item, 

Of_The_Set : Set 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, ItenuXs_ln„Set, Item_Is_Not_ln_Set 

END 

OPERATOR IS^Subset 

SPECIFICATION 

INPUT 

Left ; Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_ls_Not_In_Set 

END 

OPERATOR Is_A_Proper_Stibset 

SPECIFICATION 

INPUT 

Left ; Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_is_Not_In_Set 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Item : intt : Item], Continue : out[t : 
Booleeui] ] 

INPUT 

Over_The__Set ; Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_IsJJot_In^Set 

END 

END 

IMPLEMENTATION ADA Set_SiiT?>le_Sequential_Unbounded_J4anaged_Iterator 
END 
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SET SIMPLE SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Set_Simple_Sequential_Unboundec3LManage<i_Noniterator is 
type Set is limited private; 

procedure Copy {Froin^The_Set : in Set; 

To_The_Set : in out Set); 

procedure Clear {The_Set : in out Set); 

procedure Add (The^Item : in Item; 

To_The_Set : in out Set); 

procedure Remove (The_Item : in Item; 

From_The_Set ; in out Set); 

procedure Union (Of_The_Set : in Set; 

And_The_Set : in Set; 

To_The_Set ; in out Set); 

procedure Intersection (Of_The_Set : in Set; 

An<3LThe_Set : in Set; 

To_The_Set : in out Set); 

procedure Difference (Of_The_Set : in Set; 

AncLThe^Set : in Set; 

To_The_Set : in out Set); 

— modified by Tuan Nguyen 

— 20 Aug 95 

— replacing fianctions with procedures 


procedure Is^Equal {Left : rn Set; 

Right : in Set; 

Result : out Boolean); 

procedure Extent_Of {The^Set : in Set; 

Result : out Natural); 


procedure Is_Enpty (The_Set : in Set; 

Result ; out Boolean); 

procedure Is_A_Jleniber (The__Item ; in Item; 

Of_The_Set : in Set; 

Result : out Boolean); 

procedure Is^Subset {Left : in Set; 

Right : in Set; 

Result : out Boolean); 

procedure Is_J\^Proper_Subset (Left : in Set; 

Right ; in Set; 

Result : out Boolean); 

— end of modification 

function Is_Egual {Left : in Set; 

Right : in Set) return Boolean; 

function Extent_Of (The_Set : in Set) return Natural; 

function Is_Ertpty (The^Set ; in Set) return Boolean; 

function Is_A^ember (The_Item : in Item; 

Of_The_Set : in Set) return Boolean; 

function Is_A_Subset (Left ; in Set; 

Right : in Set) return Boolean; 

function Is_A_Froper_Subset {Left : in Set; 

Right : in Set) return Boolean; 

Overflow : exception; 

ItenuIs_In_Set : exception; 

Item_Is_Not_In_Set : exception; 

private 

type Node; 

type Set is access Node; 

end Set_Siii?)le_Seguential_Unbounded_ManagedJIoniterator; 
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SET SIMPLE SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

— "Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


with Storage_Jlanager_Sequential; 

package body Set_Simple_Seguential_UnboundedJlanagedJWoniterator is 

type Node is 
record 

The_Item : Item; 

Next : Set; 

end record; 

procedure Free {The_Node : in out Node) is 
begin 

null; 
end Free; 

procedure Set^ext (The_Node : in out Node; 

To_Next : in Set) is 

begin 

The_^ode. Next ; = To_Next; 
end SetJMext; 

function Next.Of (TheJNode : in Node) return Set is 
begin 

return The_Node.Next; 
end Next_0f; 

package Node_Manager is new Storage_Nanager_Sequential 

(Item => Node, 

Pointer => Set, 

Free => Free, 

Set_Pointer => Set_Next, 
Pointer_0f => Next_Of); 

procedure Copy (FrorcL.The_Set : in Set; 

To_The_Set : in out Set) is 
Fronuindex : Set := From_The_Set; 

To^lndex : Set; 
begin 

Node_Jlanager. Free (To_The_Set) ; 
if Froit\_The_Set /= null then 

To_The_Set := NodeJlanager.New_Item; 

To_The_Set.The_Item := From_Index.The_Item; 

To_Index := To_The_Set; 

From^Index ;= From_Index.Next; 
while From_Index /= null loop 

To_Index. Next : = Node_llanager. New_Itern ; 

To_Index := To_Index.Next; 

To_Index.The_Item := From_Index.The_Item; 
Fronuindex := From_Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Set : in out Set) is 
begin 

Node_Manager, Free (The_Se t); 
end Clear; 

procedure Add (The_Item : in Item; 

To_The_Set : in out Set) is 
TenporaryJNode : Set; 

Index : Set ;= To_The_Set; 

begin 

while Index /= null loop 

if Index.The_Item = The^Item then 
raise Iten\_Is_In_Set; 

else 

Index Index.Next; 
end if; 
end loop; 

Temporary_Node := Node_Nanager.New_Item; 

Temporary_Node .The_Item := The_Item; 

TenporaryJNode.Next := To_The_Set; 

To_The_Set ;= Tenporary^Node; 
exception 

when Storage^Error => 
raise Overflow; 

end Add; 


procediire Remove (The_Item : in I tern; 

FrortL.The_Set : in out Set) is 
Previous : Set; 


Index : Set ;= FrottL.'Ihe_Set; 
begin 

while Index /= null loop 

if Index.The_Item = The_Item then 
if Previous = null then 

From_The_Set := From_The_Set,Next; 

else 

Previous.Next ;= Index.Next; 
end if; 

Index.Next := null; 

NodeJIanager. Free (Index} ; 
return; 

else 

Previous := Index; 

Index := Index.Next; 
end if; 
end loop; 

raise ItenL.Is_^ot„In_Set; 
end Remove; 


procedure Union (Of_The_Set ; in 
And_The_Set: in 


Set; 
Set; 

To_The_Set : in out Set) is 
Set Of_The_Set; 

Set; 

Set; 

Set; 


Fronulndex 
To_Index 
To_Top 

Temporary_Node 
begin 

Node_Manager,Free(To_The_Set); 
while From_Index /= null loop 

Temporary^Node := Node_Manager .New_Item; 

TerrporaryJTode.The^Itern := From_Index.The__Item; 
TenporaryJNode .Next ;= To_The_Set; 

To_The_Set := Teiiporary_JJode; 

Fronulndex Froituindex.Next; 

end loop; 

From_Index := Ancl_The_Set; 

To_Top := To_The_Set; 
while Fronulndex /= null loop 
To_Index := ToJTop; 
while To_Index /= null loop 

if Fronulndex.The_Item = To_Index,The_Item then 
exit; 


To_Index ;= To_Index,Next; 
end if; 
end loop; 

if To_Index = null then 

Temporeiry_Node : = Node_Manager. New_Itern; 
Temporary__Node.The_Item ;= Fronulndex.The^Itern; 
Temporary^Node.Next := To_The_Set; 

To_The_Set := Temporary^ode; 
end if; 

Fronulndex := Fronulndex.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Union; 

procedure Intersection {Of_The_Set ; in Set; 

And_The_Set : in Set; 

To_The_Set ; in out Set) is 

Of^Index : Set := Of_The_Set; 

AncLIndex ; Set; 

Tenporary_Node : Set; 
begin 

Node_Manager.Free(To_The_Set); 
while Of_Index /= null loop 
And_Index := And_The_Set; 
while And_Index /= null loop 

if Of_Index.The_Item = And_Index.The_Item then 
Tenporary_Node : = Node_Manager .New_Item; 
TemporaryJNode. The_.Item ; = Of_lndex. The_Item; 
Tenporary^Node.Next := To_The_Set; 

To_The_Set Tenporary JNode; 

exit ; 

else 

And_Index := And_Index.Next; 
end if; 
end loop; 

Of_Index := Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Intersection; 

procedure Difference {Of_The_Set : in Set; 

AneLThe_Set : in Set; 

To_The_Set : in out Set) is 

Of^Index ; Set := Of_The_Set; 

AndLIndex ; Set; 

Tenporary JNode : Set; 

begin 

Nodejtonager. Free (To_The_Se t); 
while Of_Index /= null loop 
AndLIndex := And^The_Set; 
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while AncLIndex /= null loop 

if Of_Index.The_Item = And_Index.The_Item then 
exit; 

else 

And_Index := AncSLIndex.Next; 
end if; 
end loop; 

if And_Index = null then 

Tert^Jorary^Node := NodeJlanager.New_Itern; 
Teir?)orary_Node.The_Itein := Of_Index.The_Item; 
Tenporary^Node.Next ;= To_The_Set; 

To_The_Set := TenrporaryJJode; 
end if; 

Of_Index := Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Difference; 

modified by Tuan Nguyen 
20 Aug 95 

replacing functions with procedures 


procedure Is_Equal {Left 

Right 
Result 

begin 

Result :“ Is„Equal(Left,Right); 
end Is_Equal; 

procedure Extent_Of (The_Set 

Result 

begin 

Result := Extent_Of(The^Set); 
end Extent_Of; 


in Set; 
in Set; 

out Boolean) is 


in Set-¬ 
out Natural) is 


procedure Is_En?>ty (The_Set : in Set; 

Result : out Boolean) is 

begin 

Result := Is^Enpty(The_Set); 
end Is_Enpty; 


procedure Is^AJIember 


{The_Item : in I tern; 
Of_The_Set : in Set; 
Result : out Boolean) 


begin 

Result := Is_AJlember(The_Item,Of_The_Set) ; 
end Is_AJ5ember; 


is 


procedure Is^A^-Subset {Left 

Right 
Result 

begin 

Result := Is^A^Subset{Left,Right); 
end Is_A_Subset; 


in Set; 
in Set; 

out Boolean) is 


procedure Is^A^Proper_Subset 


(Left 

Right 

Result 


in Set; 
in Set; 
out Boolean) 


begin 

Result := Is_A_Proper_Subset(Left,Right) ; 
end Is_A_Proper_Svibset; 


is 


end of modification 


function Is_Egual {Left : in Set; 

Right : in Set) return Boolean is 
Left_Co\jnt : Natural := 0; 

Right_Coxint ; Natural := 0; 

Left_Index ; Set := Left; 

Right_Index : Set; 

begin 

while Left_Index /= null loop 
Right_Index ;= Right; 
while Right_Index /= null loop 

if Left_Index.The_Itein = Right_Index.The_Item then 
exit ; 

else 

Right^Index := Right^Index.Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

else 

Left_Count ;= Left_Count + 1; 

Left_Index := Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 


while Right^Index /* null loop 

Right_Co\jnt := Right_Count + 1; 

Right_Index Right_Index.Next; 

end loop; 

return (Left_Count = Right_Count); 
end Is_Equal; 

fimction Extent_0f {The_Set : in Set) return Natural is 
Coiant : Natural := 0; 

Index : Set := The„Set; 

begin 

while Index /= null loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
retum Count; 
end Extent_Of; 

function Is^Empty (The_Set : in Set) return Boolean is 
begin 

return (The_Set = null); 
end ls_En 5 )ty; 

function Is_A«Kember (The_Iteiii : in Item; 

Of_The_Set : in Set) return Boolean is 
Index : Set := Of_The_Set; 
begin 

while Index /= null loop 

if The_Item = Index.The_Itern then 
return True; 
end if; 

Index := Index.Next; 
end loop; 
return False; 
end Is_AJleinber; 

fiuiction Is_A_Subset (Left : in Set; 

Right : in Set) return Boolean is 
Left_Index ; Set Left; 

Right_Index : Set; 
begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right^Index /= null loop 

if Left_Index.The_Item *= Right_Index.The_Item then 
exit; 

else 

Right_Index Right_lndex.Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

else 

Left_lndex := Left_Index.Next; 
end if; 
end loop; 
return True; 
end Is^A^Subset; 

fianction Is_^_Proper_Subset (Left : in Set; 

Right : in Set) return Boolean is 
Left_Co\mt : Natural := 0; 

Right_Count : Natural := 0; 

Left_Index : Set := Left; 

Right_Index : Set; 

lOegin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right_Index Right_Index.Next; 

end if; 
end loop; 

if Right_Index « null then 
return False; 

else 

Left_Count := Left_Count + 1; 

Left_Index ;= Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right_Index /= null loop 

Right^Count ;= Right_CO\int + 1; 

Right_Index Right_Index.Next; 
end loop; 

return (Left_Count < Right_Count); 
end ls^A_Proper_Subset; 

end Set_Sinple_Sequential_UnboundedJManaged_Non iterator; 
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SET SIMPLE SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Set_Siir?>le_Seqaential_UnboundedJManagec3jNoniterator 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FronL_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Iteirt_Is^In„Set, Item_IsJNot_In_^Set 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Set : Set 
OUTPUT 

The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Iten\_Is_JJot_In_Set 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item ; Item, 

To_The_Set : Set 
OUTPUT 

To_The_Set ; Set 
EXCEPTIONS 

Overflow, Item_IS—In_Set, Item_Is_Not_In_Set 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The_Item : Item, 

Fron\jrhe_Set : Set 
OUTPUT 

From_The_Set : Set 
EXCEPTIONS 

Overflow, Iteitt.Is_In_Set, ItexcuIs_Not_In_Set 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 

And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set ; Set 
EXCEPTIONS 

Overflow, Item_Is_In.Set, IteituIs_Not_In_Set 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Set ; Set, 

And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, IteitL.Is_Not_In_Set 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 


And^The^Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, ItenL.Is_In_Set, Item_Is_Not_In_Set 

END 

OPERATOR Is^Equal 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ltem_ls_ltL.Set, ltem.l5jsrot_ln_Set 

END 

OPERATOR Extent_Of 

SPECIFICATION 

INPUT 

The_Set ; Set 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_Is_Not_In_Set 

END 

OPERATOR Is_Empty 

SPECIFICATION 

INPUT 

The_Set : Set 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_ls_ln_„Set, Item_Is_Not_In_Set 

END 

OPERATOR Is_A^einber 

SPECIFICATION 

INPUT 

The_Item : Item, 

Of_The„Set : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_ls_InL_Set, Item_Is_Not_ln_Set 

END 

OPERATOR Is_A_Subset 

SPECIFICATION 

INPUT 

Left : Set, 

Right ; Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_In_Set, ItenuIs_Not_In_Set 

END 

OPERATOR Is^R^Proper_Subset 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ltem_Is_In_Set, ItenuIs_Not_In_Set 

END 

END 

IMPLEMENTATION ADA Set_Siirple_Sequential_Unbounded_JIanaged_Noniterator 
END 
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SET SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Set_Siir5>le_Sequential_Uiibo\inded^Uninanaged_Iterator is 


type Set is limited private; 




procedure 

Copy 

(FrortuThe_Set 

in 


Set; 



To„The_Set 

in 

out 

Set) ; 

procedure 

Clear 

(The_Set 

in 

out 

Set) ; 

procedure 

Add 

(The_Item 

in 


Item; 



To_The_Set 

in 

out 

Set) ; 

procedure 

Remove 

(The_Item 

in 


I tern; 



From_The_Set 

in 

out 

Set); 

procedure 

Union 

(Of_The_Set 

in 


Set; 



AndLThe^Set 

in 


Set; 



To_The_Set 

in 

out 

Set) ; 

procedure 

Intersection 

(Of_The_Set 

in 


Set; 



And_The_Set 

in 


Set; 



To_The_Set 

in 

out 

Set) ; 

procedure 

Difference 

(Of_The_Set 

in 


Set; 



And^The„Set 

in 


Set; 



To_The_Set 

in 

out 

Set) ; 

modified by Tuan Nguyen 





20 Aug 95 






replacing 

functions with procedures 




procedure 

Is_Equal 

(Left 


; in 

Set; 



Right 


; in 

Set; 



Result 


out Boolean); 

procedure 

Extent^Of 

(The^Set 


in 

Set; 



Result 


out Natural); 

procedure 

Is_Enpty 

(The_Set 


in 

Set; 



Result 


out Boolean); 

procedure 

Is^AJMember 

(The^Item 

in 

Item; 



Of_The_Set 

; in Set; 



Result 

: out Boolean); 


procedure Is^A^Subset 

(Left 

: in Set; 


Right 

: in Set; 



Result 

: out Boolean); 


procedure Is^A_Proper_Subset 

(Left 

: in Set; 


Right 

: in Set; 



Result 

; out Boolean); 


end of modification 




function Is_Equal 

(Left : 

in Set; 



Right : 

in Set) return 

Boolean; 

function Extent_Of 

(The_Set : 

in Set) return 

Natural; 

function Is_Empty 

(The_Set : 

in Set) return 

Boolean; 

function Is_A-lIember 

(The_Item : 

in Item; 

Boolean; 

Of_The_Set : 

in Set) return 

function Is^_Subset 

(Left 

in Set; 

Boolean; 


Right : 

in Set) return 

f\mction Is_A>Proper_Subset 

(Left : 

in Set; 

Boolean; 

Right : 

in Set) return 


generic 

with procedure Process (The_Item : in Item; 

Continue : out Boolean); 
procedure Iterate {Over_The_Set : in Set); 

Overflow : exception; 

Item_Is_In_Set : exception; 

Item_IsJNot_In_Set : exception; 

private 

type Node; 

type Set is access Node; 

end Set_Sin^le_Sequential_Unbounded_Unmanaged^Iterator; 
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SET SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

-- Serial Nviinber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in s\ibdivision {b) (3) (ii) 

— of the rights in Technical Data and Coirputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S, Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Set_Sinple_Sequential_UnboundedLUnmanaged_Iterator is 

type Node is 
record 

The_Item : Itern; 

Next : Set; 
end record; 


procedure Copy (FronL.The_Set : in Set; 

To„The_Set : in out Set) is 
Froin_Index : Set := Froitt,The_Set ; 

To^Index ; Set; 
begin 

if Fronu.'nTie_Set = null then 
To_The_Set := null; 

else 

To_The_Set := new Node'(The_Item => FronuIndex.The_Item, 
” Next => null); 


To_Index := To_The_Set; 

Fron^Index : = Froin_Index, Next ; 
while Fron\_Index /* null loop 

To_Index.Next := new Node' (The_Item => 
Fronulndex. The_Itein, 

Next => null); 


To_Index To_Index.Next; 
Froitulndex := Froirt.Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 


end Copy; 


procedure Clear {The_Set ; in out Set) is 
begin 

The_Set : null; 
end Clear; 


procedure Add (The^Item : in Item; 

To_The_Set : in out Set) is 
Index ; Set ;= To_The_Set; 
begin 

while Index null loop 

if Index.The_Item = The^Item then 
raise Itent_Is_In..Set ; 

else 

Index := Index.Next; 
end if; 
end loop; 

To_The_Set := new Node ‘ (The_Itern => The_Item, 

Next => To_The_Set); 

exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Remove (The_Item : in Item; 

From_The_Set : in out Set) is 
Previous : Set; 

Index : Set := From_The_Set; 
begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 
if Previous = null then 

ProituThe_Set := FronuThe^Set .Next; 

else 

Previous. Next : = Index. Next ; 
end if; 
return; 

else 

Previous Index; 

Index ;= Index.Next; 
end if; 
end loop; 

raise Itent.Is_Not_In_Set; 
end Remove; 

procedure Union (Of_The_Set : in Set; 

Andjrhe_Set: in Set; 

To_The_Set : in out Set) is 

From^Index : Set := Of_The..Set; 

To_Index : Set; 

To_Top : Set; 

begin 


To_The_Set := null; 

while FroirL,Index null loop 

To_The_Set new Node’(The_Itern => FronuIndex.The_Item, 
Next => To_The_Set) ; 
Frortuindex FronuIndex.Next; 
end loop; 

Frorrulndex := And^The_Set; 

To_Top := To_The_Set; 
while Fronuindex /= null loop 
To_Index := To_Top; 
while To_Index /= null loop 

if FroituIndex.The_Item *= To_Index.The_Item then 
exit; 


else 


To_Index := To_Index.Next; 
end if; 
end loop; 

if To_Index = null then 

To_The_Set := new Node’(The^Item 
Fronulndex.The_Itern, 


Next 


end if; 

Froirt.Index := Fronulndex. Next ; 
end loop; 
exception 

when Storage_Error ss> 
raise Overflow; 
end Union; 


=> To_The_Set); 


procedure Intersection (Of_The_Set : in Set; 

And-.The_Set ; in Set; 

To_The_Set : in out Set) is 

Of_Index ; Set ;= Of_The_Set; 

AndLIndex : Set; 
begin 

To_The_Set := null; 
while Of_Index /= null loop 
AndLIndex := And_The_Set; 
while AndLIndex /= null loop 

if Of_Index.The_Item = AndLIndex.The_Itern then 
To_The_Set new Node' (The„Item => 


Of^Index. The^Item, 


Next => To„The_Set); 


exit; 

else 

AndLIndex := AndLIndex,Next; 
end if; 
end loop; 

Of_Index Of^Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Intersection; 


procedure Difference (Of„The_Set : in Set; 

AndLThe_Set ; in Set; 

To_The_Set : in out Set) is 

Of_Index : Set := Of_The_Set; 

AndLIndex : Set; 
begin 

To_The_Set:= null; 
while Of_Index /= null loop 
AndLIndex := AndLThe_Set; 
while AndLIndex /= null loop 

if Of_Index.The_Item ® AndLIndex.The_Itern then 
exit; 

else 

AndLIndex ;= AndLIndex. Next ; 
end if; 
end loop; 

if And_Index = null then 

To_The„Set := new Node' {The_Itern => Of_Index.The_Item, 
Next => To_The_Set); 

end if; 

Of_Index ;= Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Difference; 

— modified by Tuan Nguyen 
20 Aug 95 

— replacing fxmctions with procedures 


procedure Is_Equal (Left 

Right 
Result 

begin 

Result := Is_Equal(Left,Right}; 
end ls_E< 3 ual; 

procedure Extent_Of (The_Set 

Result 

begin 

Result ;= Extent_Of(The_Set); 


: in Set; 

: in Set; 

; out Boolean) is 


: in Set; 

: out Natural) is 
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end Extent_Of; 
procedure Is_Eitpty 


(The_Set : in Set; 

Result : out Boolean) is 

begin 

Result := Is_Enpty(The_Set); 
end Is_Einpty; 


procedure Is_A_JWeinber 


(The_Item ; in Item; 
Of_The_Set : in Set; 
Result : out Boolean) 

begin 

Result : = Is_AJleiriber (The_Item, Of_The_Set) ; 
end Is_JVu_Meiiiber ; 


procedure Is^A^SiJbset (Left 

Right 
Result 

begin 

Result := Is.JV_S\ibset (Left,Right) ; 
end Is_A^Subset; 


in Set; 
in Set; 

out Boolean) is 


procedure Is_A_Proper_Subset 


(Left 

Right 

Result 


in Set; 
in Set; 
out Boolean) 


begin 

Result := Is_A_Proper_Subset(Left,Right); 
end Is_A_Proper_Subset; 


is 


end of modification 

fxmction Is_Equal (Left : in Set; 

Right : in Set) return Boolean is 
Left_Count : Natural := 0; 

Right_Count : Natural := 0; 

Left_Index ; Set := Left; 

Right_Index : Set; 

begin 

while Left_Index /= null loop 
Right_Index Right; 
while Right_Index /= null loop 

if Left_Index.The_Item Right_Index.The_Item then 
exit; 

else 

Right^Index ;= Right_Index.Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

else 

Left^Count := Left_Count + 1; 

Left_lndex := Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right_Index /= null loop 

Right_Count := Right_Count + 1; 

Right_Index := Right^Index. Next ; 
end loop; 

return (Left_Count = Right_Count); 
end Is_Equal; 

function Extent_Of (The_Set ; in Set) return Natural is 
Count : Natural := 0; 

Index ; Set := The_Set; 

begin 

while Index /= null loop 
Coimt := Coxint + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Extent_Of; 

fxmction Is_Err? 3 ty {The_Set : in Set) return Boolean is 
begin 

return (The^Set = null); 
end Is_Eit?>ty; 

function Is_A_Meiriber (The_Item : in Item; 


Of_The_Set : in Set) return Boolean is 
Index : Set := Of_The_Set; 
begin 

while Index /= null loop 

if The_Item = Index.The_Item then 
return True; 
end if; 

Index := Index.Next; 
end loop; 
return False; 
end Is_AJMeinber; 

function Is^^Subset (Left : in Set; 

Right : in Set) return Boolean is 
Left_Index ; Set := Left; 

Right_Index : Set; 
begin 

while Left_Index /= null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Right_Index =. null then 
return False; 

else 

Left_Index := Left_Index.Next; 
end if; 
end loop; 
return True; 
end Is_A^Subset; 

function Is,^Proper_Subset (Left ; in Set; 

Right : in Set) return Booleeui is 
Left_Count : Natural ;= 0; 

Right_Count : Natural := 0; 

Left_Index : Set := Left; 

Right_lndex : Set; 
begin 

while Left__Index /= null loop 
Right_Index :== Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit ; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Right_Index = null then 
return False; 

else 

Left_Count := Left_Count + 1; 

Left^Index t- Left_Index.Next; 
end if; 
end loop; 

Right_Index z~ Right; 

while Right_lndex /= null loop 

Right_Count := Right_Count + 1; 

Right_Index := Right_Index.Next; 
end loop; 

return (Left_Coxmt < Right_Co\int) ; 
end Is_JUProper_Subset; 

procedure Iterate (Over_The_Set : in Set) is 
The_Iterator : Set := Over_The_Set; 

Continue : Boolean; 

begin 

while The_Iterator /= null loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end set_Siiiple_Sequential_Unbounded_Unmanaged_Iterator; 
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SET SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

PSDL 

TXPE Set Sin 5 >le_Sequential_Unbounded_UnmanagecLIterator 

END 

SPECIFICATION 


GENERIC 

OPERATOR Is_Equal 

Item ; PRIVATE TYPE 

SPECIFICATION 

OPERATOR Copy 

INPUT 

SPECIFICATION 

Left : Set, 

INPUT 

Right : Set 

From_The Set : Set, 

OUTPUT 

To The Set : Set 

Result : Boolean 

OUTPUT 

EXCEPTIONS 

To The Set : Set 

Overflow, ItenL.Is_IrL_Set, Itein_IsJNot_In_Set 

EXCEPTIONS 

END 

Overflow, Item_Is In Set, Itern_Is_Not_In_Set 

OPERATOR Extent^Of 

SPECIFICATION 

END 

OPERATOR Clear 

INPUT 

SPECIFICATION 

The_Set : Set 

INPUT 

OUTPUT 

The Set : Set 

Result : Natural 

OUTPUT 

EXCEPTIONS 

The Set : Set 

Overflow, IteitL.Is_In_Set, IteiTu.Is_Not_In_Set 

EXCEPTIONS 

END 

Overflow, Item_Is In_Set, Iten^_Is_Not_In_Set 


END 

OPERATOR Is^Empty 

SPECIFICATION 

OPERATOR Add 

INPUT 

SPECIFICATION 

The_Set : Set 

INPUT 

OUTPUT 

The_Item ; Item, 

Result : Boolean 

To The Set : Set 

EXCEPTIONS 

OUTPUT 

Overflow, Iteitu,Is_In_Set, IteiiL.Is_Not_In_Set 

To_The_Set : Set 

END 

EXCEPTIONS 


Overflow, Itenuls In Set, Item_IsJJot_In_Set 

OPERATOR Is^RJIember 

END 

SPECIFICATION 

INPUT 

OPERATOR Remove 

The_Item : Item, 

SPECIFICATION 

Of_The_Set : Set 

INPUT 

OUTPUT 

The Item : Item, 

Result : Boolean 

From_The Set : Set 

EXCEPTIONS 

OUTPUT 

Overflow, IteitL.Is_In_Set, Item_Is_Not_In_Set 

Fron\jrhe_Set : Set 

END 

EXCEPTIONS 


Overflow, IterrL.Is In Set, Item_Is_Not_In_Set 

OPERATOR IS_A^Subset 

END 

SPECIFICATION 

INPUT 

OPERATOR Union 

Left ; Set, 

SPECIFICATION 

Right ; Set 

INPUT 

OUTPUT 

Of The Set r Set, 

Result : Boolean 

And_The Set ; Set, 

EXCEPTIONS 

To The Set : Set 

Overflow, Item_Is_In_Set, It€m_Is_Not_In_Set 

OUTPUT 

END 

To The Set ; Set 


EXCEPTIONS 

OPERATOR Is^A^Proper_Subset 

Overflow, ltem_Is In Set, Item_ls_Not„In^Set 

SPECIFICATION 

END 

INPUT 

Left : Set, 

OPERATOR Intersection 

Right : Set 

SPECIFICATION 

OUTPUT 

INPUT 

Result : Boolean 

Of The Set ; Set, 

EXCEPTIONS 

And_The Set : Set, 

Overflow, Item_Is_In_Set, ltem_Is_Not_In_Set 

To_The_Set : Set 

END 

OUTPUT 


To_The_Set : Set 

OPERATOR Iterate 

EXCEPTIONS 

SPECIFICATION 

Overflow, Iteit\_ls_In_Set, ItenuIs_Not_In_Set 

GENERIC 

END 

Process : PROCEDUREIThe_Itern : in[t : Item], Continue : out[t : 

Boolean]] 

OPERATOR Difference 

INPUT 

SPECIFICATION 

Over_The_Set : Set 

INPUT 

EXCEPTIONS 

Of_The_Set : Set, 

Overflow, Item_Is_In_Set, ItenuIsJNot_In^Set 

And_The_Set : Set, 

END 

To_The_Set : Set 


OUTPUT 

END 

To_The_Set : Set 

IMPLEMENTATION ADA Set_SiKple_Seguential_Unbounded_Unmanaged_Iterator 

EXCEPTIONS 

END 

Overflow, Iteii\_Is„In_Set, Item_IsJNot_In_Set 
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SET SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Set Simple Sequential^Unbotznded^UnmanagedLNoniterator is 


type Set is limited private; 




procedure 

Copy 

(From_The_Set 

in 


Set; 



To_The_Set 

in 

out 

Set) ; 

procedure 

Clear 

(The_Set 

in 

out 

Set) ; 

procedure 

Add 

(The^Item 

in 


Item; 



To_The_Set 

in 

out 

Set) ; 

procedure 

Remove 

(The^Item 

in 


Item; 



Fr omJThe^Se t 

in 

out 

Set) ; 

procedure 

Union 

(Of_The_Set 

in 


Set; 



And_The_Set 

in 


Set; 



To_The„Set 

in 

out 

Set) ; 

procedure 

Intersection 

(Of_The_Set 

in 


Set; 



AncLThe_,Set 

in 


Set; 



To_The_Set 

in 

out 

Set); 

procedure 

Difference 

(Of_The_Set 

in 


Set; 



AncLThe_Set 

in 


Set; 



To_The_Set 

in 

out 

Set); 

modified by Tuan Nguyen 




20 Aug 95 






replacing 

fiinctions with procedures 




procedure 

Is_Equal 

(Left 


i in 

Set; 



Right 


; in 

Set; 



Result 


out Boolean); 

procedure 

Extent^Of 

(The^Set 


in 

Set; 



Result 


out Natural); 

procedure 

Is_Enpty 

(The^Set 


in 

Set; 



Result 

out Boolean); 

procedure Is^A_Hember 

(The_Item 

in Item; 

Of_The_Set 

in Set; 


Result 

out Boolean); 

procedure Is_A_Subset 

(Left 

in Set-¬ 

Right 

in Set; 


Result 

out Boolean); 

procedure Is_A^Proper_Subset 

(Left 

in Set; 

Right 

in Set; 


Result 

out Boolean); 

end of modification 

function Is_Equal 

(Left : 

in Set; 

Right : 

in Set) return Boolean 

function Extent_Of 

(The_Set : 

in Set) return Natural 

function Is_Enr?5ty 

(The^Set ; 

in Set) return Boolean 

function Is_Au_Meinber 

(The_Item : 

in Item; 

Of The^Set : 

in Set) return Boolean 

function Is_A^Subset 

(Left : 

in Set; 

Right : 

in Set) return Boolean 

function Is_A^Proper_Subset 

(Left : 

in Set; 

Right : 

in Set) return Boolean 

Overflow : exception; 


IteituIs_ln_Set : exception; 


Iten\_Is_JJot_In_Set : exception; 



private 

type Node; 

type Set is access Node; 

end Set_Simple_Se«3uential_Unbounded_UnmanagedJJoniterator; 


228 









SET SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Set_Siittple_Sequential_Unbounded^UnmanagedLNoniterator is 

type Node is 
record 

The_Item : I tern; 

Next : Set; 
end record; 


procedure Copy (FroirL.The_Set : in Set; 

To_The_Set : in out Set) is 
Fronulndex : Set := FroitL.The_Set; 

To_Index : Set; 
begin 

if FronL.The_Set = null then 
To_The_Set := null; 

else 

To_The_Set := new Node' (The_Itern => Froit_Index.The_Item, 
Next => null); 


To_Index := To_The_Set; 

Fronuindex := Fronulndex.Next; 
while Fronulndex /= null loop 

To_Index.Next := new Node *(The_Itern => 
Fron^_Index. The_Itein, 

Next => null); 


To_Index To_Index.Next; 

Fronuindex := From^Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear {The_Set ; in out Set) is 
begin 

The_Set := null; 
end Clear; 


procedure Add {The_Item : in Itern; 

To_The_Set : in out Set) is 
Index : Set To_The_Set; 
begin 

while Index /= null loop 

if Index.The_Item = The_Itein then 
raise ItenuIs^In^Set; 

else 

Index := Index.Next; 
end if; 
end loop; 

To_The_Set := new Node'(The_Itern => The_Item, 

Next => To_The_Set) ; 

exception 

when Storage_Error => 
raise Overflow; 

end Add; 

procedure Remove (The_Item : in I tern; 

From_The_Set : in out Set) is 
Previous : Set; 

Index : Set := From_The_Set; 
begin 

while Index /= null loop 

if Index.The_Itern = The_Item then 
if Previous = null then 

From_The_Set := FronuThe_Set.Next; 

else 

Previous.Next Index-Next; 

end if; 
return; 

else 

Previous := Index; 

Index Index.Next; 
end if; 
end loop; 

raise Iteir^_IsJNot_In^Set; 
end Remove; 

procedure Union (Of_The_Set : in Set; 

AncLThe_Set: in Set; 

To_The_Set : in out Set) is 

Froat_Index : Set := Of_The_Set; 

To_Index ; Set; 

To_Top : Set; 

begin 


To_The_Set := null; 

while From_Index /« null loop 

To_The_Set ;= new Node* {The_Itern => From_Index.The_Item, 
Next => To_The_Set); 
Froiruindex := FronuIndex.Next; 
end loop; 

From^Index And_The_Set; 

To_Top := To_The_Set; 
while Frooulndex /== null loop 
To_Index ;= To_Top; 
while To_Index /= null loop 

if FronuIndex-The_Item = To_Index.The_Item then 
exit; 


else 


To_Index := To_Index.Next; 
end if; 
end loop; 

if To_Index = null then 

To_The_Set new Node’ (The_Item 
Fr onuindex. The_I tern, 


Next 


To_The_Set); 


end if; 

Fronulndex := FronuIndex.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Union; 


procedure Intersection (Of_The_Set : in Set; 

AndUThe_Set : in Set; 

Tojrhe^Set : in out Set) is 

Of_Index : Set := Of_The_Set; 

AncSLIndex ; Set; 
begin 

To_The_Set := null; 
while Of_Index /= null loop 
And_Index ;= And_The_Set; 
while And_Index /= null loop 

if Of_Index.The_Item » And^Index.The^Item then 
To_The_Set := new Node'(The_Item => 


Of_Index.The_Itern, 


Next => To_The_Set); 


exit; 

else 

An<i_Index ;= And^Index.Next; 
end if; 
end loop; 

Of_Index := Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Intersection; 


procedure Difference {Of_The_Set : in Set; 

And_The_Set : in Set; 

To_The_Set : in out Set) is 

Of_Index : Set ;= Of_The_Set; 

And_Index : Set; 
begin 

To_The_Set:= null; 
while Of_Index /= null loop 
AncLIndex ;= And_The„Set; 
while And_Index /= null loop 

if Of_Index.The_Item = AndLIndex.The_Item then 
exit; 

else 

AncLIndex i- AncSLIndex.Next; 
end if; 
end loop; 

if And_Index - null then 

To_The_Set :« new Node' (The_Itern => Of_Index.The_Item, 
Next => To_The_Set); 

end if; 

Of^Index := Of_Index.Next; 
end loop; 
exception 

when Storage_Error => 
raise Overflow; 
end Difference; 


— modified by Tucui Nguyen 

— 20 Aug 95 

— replacing fiinctions with procedures 


procedure Is_Equal (Left 

Right 
Result 

begin 

Result :- Is_Equal(Left,Right); 
end Is_Equal; 

procedure Extent^Of (The^Set 

Result 

begin 

Result := Extent_0f (The-_Set) ; 


in Set; 
in Set; 

out Boolean) is 


in Set; 

out Natural) is 
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end Extent_Of; 


procedure Is_Empty {The_Set : in Set; 

Result : out Boolean) is 

begin 

Result := Is__Errpty{The_Set) ; 
end Is_Eitpty; 


procedure IsJR^ember 


(The_Item : in Item; 
Of_The_Set : in Set; 
Result : out Boolean) 

begin 

Result := Is_A>.Member (The_Item,Of_The_Set); 
end Is_AJMeiriber; 


procedure Is^ft^_Subset (Left 

Right 
Result 

begin 

Result := Is_A^Subset(Left,Right); 
end Is_A-Subset; 


in Set; 
in Set; 

out Boolean) is 


procedure IsJv_Proper_Subset 


(Left 

Right 

Result 


in Set; 
in Set; 
out Boolean) 


begin 

Result := Is_A_Proper_Subset(Left,Right); 
end Is_A^Proper_Subset; 


is 


end of modification 


function Is_Equal (Left : in Set; 

Right : in Set) return Boolean is 
Left_Co\int : Natural := 0; 

Right_Count : Natural ;= 0; 

Left_Index ; Set := Left; 

Right_Index : Set; 

begin 

while Left^Index /» null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index-The_Item = Right_Index.The_Item then 
exit ; 

else 

Right_Index Right^Index.Next; 
end if; 
end loop; 

if Right_lndex = null then 
return False; 

else 

Left^Count ;= Left_Count + 1; 

Left_Index := Left_Index.Next; 
end if; 
end loop; 

Right__Index ;= Right; 

while Right^Index /= null loop 

Right_Cotint Right_Count + 1; 

Right_Index Right_Index*Next; 
end loop; 

return (Left_Count = Right_Count); 
end ls_Equal; 

function Extent_Of (The_Set : in Set) return Natural is 
Count ; Natural := 0; 

Index : Set := The^Set; 

begin 

while Index /= null loop 
Co\mt := Count + 1; 

Index := Index.Next; 
end loop; 
return Count; 
end Extent_Of; 


function Is_Ettipty (The^Set : in Set) return Boolean is 
begin 

retxim (The^Set = null) ; 
end Is^Enpty; 

function Is_A_Neinber (The_Item : in Item; 

Of_The_Set : in Set) return Boolean is 
Index : Set ;= Of_The_Set; 
begin 

while Index /= null loop 

if The_Item = Index.The_Itern then 
return True; 
end if; 

Index := Index.Next; 
end loop; 
return False; 
end Is^AJIember; 

function Is^^Subset (Left : in Set; 

Right ; in Set) return Boolean is 
Left_Index : Set ;= Left; 

Right_Index : Set; 
begin 

while Left_Index /= null loop 
Right^Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right_Index Right_Index.Next; 
end if; 
end loop; 

if Right_Index - null then 
return False; 

else 

Left_Index := Left_Index.Next; 
end if; 
end loop; 
return True; 
end Is_A^Subset; 

function Is_A Proper_Subset (Left : in Set; 

Right ; in Set) return Boolean is 
Left_Count : Natural := 0; 

Right^Count : Natural := 0; 

Left_Index ; Set := Left; 

Right_Index : Set; 

begin 

while Left_Index null loop 
Right_Index := Right; 
while Right_Index /= null loop 

if Left_Index.The_Item = Right_Index.The_Item then 
exit; 

else 

Right_Index := Right_Index.Next; 
end if; 
end loop; 

if Right^Index = null then 
return False; 

else 

Left_Co\mt ;= Left_Count + 1; 

Left_Index := Left_Index.Next; 
end if; 
end loop; 

Right_Index := Right; 

while Right_Index /= null loop 

Right_Count := Right_Coiant + 1; 

Right_Index := Right_Index.Next; 
end loop; 

return (Left_Count < Right_Coxmt); 
end Is_^Proper_Subset; 

end Set__Sinple__Secpiential_UnboundecLUninanagedJJoniterator; 
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SET SIMPLE SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

PSDL 


TYPE Set_SiBnple_Sequential_UnboundedLUninanaged_Noniterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Froirt_The_.Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Iteii:uIs_In_Set, IteiiuIs_Not_In_Set 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Set : Set 
OUTPUT 

The^Set : Set 
EXCEPTIONS 

Overflow, ItenuIs_In_Set, Iten\_Is_Not_In_Set 

END 

OPERATOR Add 
SPECIFICATION 
INPUT 

The_Item : Item, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Ite«uIs_In^Set, ItertL,Is_Not_In_Set 

END 

OPERATOR Remove 
SPECIFICATION 
INPUT 

The_Item : Item, 

FronuThe^Set : Set 
OUTPUT 

Froirt,The_Set : Set 
EXCEPTIONS 

Overflow, Iter^^_Is_In_Set, Item_IsJMot_Irt_Set 

END 

OPERATOR Union 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 

And_The_Set : Set, 

To_The_Set : Set 
OOTPUT 

To_The_Set ; Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item^IsJ^ot_In_Set 

END 

OPERATOR Intersection 
SPECIFICATION 
INPUT 

Of_The_Set : Set, 

And_The_Set : Set, 

To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_Is_Not_In_Set 

END 

OPERATOR Difference 
SPECIFICATION 
INPUT 

Of_The_Set ; Set, 

AncLThe^Set : Set, 


To_The_Set : Set 
OUTPUT 

To_The_Set : Set 
EXCEPTIONS 

Overflow, Item_ls_ln_Set, Itenv_Is_Not_In_Set 

END 

OPERATOR IS^Equal 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, ItenuIs_In_Set, Itein_Is_Not_In_Set 

END 

OPERATOR Extent^Of 

SPECIFICATION 

INPUT 

The^Set : Set 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Iteit\_Is_In_Set, IteiiL.Is_JJot_ln_Set 

END 

OPERATOR Is_En 5 )ty 

SPECIFICATION 

INPUT 

The_Set : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_ls_In_Set, IteitulsJJot_In_Set 

END 

OPERATOR Is_A_Member 

SPECIFICATION 

INPUT 

The_Item : Item, 

Of_The_Set : Set 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Item_Is_In_Set, Item_IsJNot_In^Set 

END 

OPERATOR Is_A-Subset 

SPECIFICATION 

INPUT 

Left ; Set, 

Right ; Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Iten\_Is_In_Set, Item_IsJNot_In_Set 

END 

OPERATOR Is.A_Proper_Subs€t 

SPECIFICATION 

INPUT 

Left : Set, 

Right : Set 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Item_Is_In_Set, ItertuIs_Not_In_Set 

END 

END 

IMPLEMENTATION ADA 

Se t_Siaple_Seguent ial_Unbounded_Unmanaged_Noni ter a tor 
END 
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BINARY SEARCH 


ADA SPECIFICATIONS 


generic 

type Key is limited private; 

type Item is limited private; 

type Index is (<>); 

type Items is array(Index range <>) of Item; 

with function Is_Equal (Left : in Key; 

Right : in Item) return 

Boolean; 

with f\jnction Is_Less_Than (Left : in Key; 

Right : in Item) return 

Boolean; 

package Binary^Search is 

— modified by Tuan Nguyen 

— 20 Jan 95 


— adding procedures to replace fionctions 


procedure Location_Of (The_Key : in Key; 

In_The_Iterns : in Items; 
Result : out Index); 


— end of modification 


fxinction Location_Of 
return Index; 


(The_Key : in Key; 

In_The_Iterns ; in Items) 


IteiruNot_Found ; exception; 


end Binary_Search; 


BINARY SEARCH 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Cooaputer 

— Software Clause of FAR 52.227-7013, Manufacturer: 

— Wizcord software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Binary_Search is 

— modified by Tuan Nguyen 

— 20 Jan 95 

— adding procedures to replace functions 

procedure Location_Of (The_Key : in Key; 

In_The„Iterns : in Items; 

Result : out Index) is 

begin 

Result := Location_Of (The^Key, In_The_Iteins) ; 
end Location^Of; 

— end of modification 


function Location^Of (The^Key : in Key; 

In_The_Iterns : in Items) 

return Index is 

Lower_Index : Index := In_The_Items‘First; 
lJpper_Index : Index In_The_Items‘Last; 
The_Index : Index; 
begin 

while Lower_Index <= upper_Index loop 
The_Index := 

Index' Val ((Index' Pos (Lower_Index) + 
Index‘Pos(Upper_Index)) / 2); 

if Is_Equal(The_Key, 
In_The_Items(The_Index)) then 

return The_Index; 
elsif Is_Less_Than(The_Key, 

In_The_Iterns(The_Index)) then 

exit when (The_Index - 
In_The_Iterns‘First); 

Upper_.Index ; = Index' Pred (The_Index); 

else 

exit when (The_Index = 

In_The_Items‘Last); 

Lower_Index ;= Index'Succ(The_Index); 
end if; 
end loop; 

raise ItemJMot^Found; 
end Location_Of; 

end Binary_Search; 


BINARY SEARCH 
PSDL 


OPERATOR Location_0f 
SPECIFICATION 
GENERIC 

Key ; PRIVATE^TYPE, 

Item : PRIVATE^TYPE, 

Index : DISCRETE_TyPE, 

Items : ARRAY [ARRAY_ELEMENT : Item, ARRAY_INDEX : 
Index) , 

IS^Equal : FUNCTION[Left ; Key, Right : Item, 
RETURN ; Boolean], 

Is_Less_Than : FUNCTION [Left : Key, Right : Item, 
RETURN : Boolean] 


INPUT 

The_Key : Key, 

In_The_lterns : Items 
OUTPUT 

Result : Index 
EXCEPTIONS 

11 enuNo t_Found 

END 

IMPLEMENTATION ADA Location_Of 
END 
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BINARY INSERTION SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array(Index range <>) of Itern; 
with function "<" (Left : in Item; 

Right : in Item) return Booleein; 


package Binary_Insertion_Sort is 

procedure Sort (The_Iterns ; in out Items); 
end Binary_Insertion^Sort; 


BINARY INSERTION SORT 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013, Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Binary_Insertion_Sort is 

procedure Sort (The_Items : in out Items) is 
Teoporary^Item : I tern; 

Left_Index ; Index; 

Middle_lndex : Index; 

Right^Index : Index; 

begin 

for Outer_Index in Index*Succ(The_Items'First) 
.. The_Iterns'Last loop 

Temporary_Item := The_Iterns(Outer_Index); 
Left_lndex := The_Items’First; 

Right_Index := Outer_Index; 

while Left_Index <= Right_Index loop 


Middle_Index := 

Index • Val ((Index ■ Pos (Le f t„Index) + 

Index * Pos(Right_Index)) / 2); 

if Tenporary_Item < 

The_I terns (Middl e_Index) then 

exit when (Middle_Index = 

The_Iterns’First); 

Right_Index := 

Index'Pred{Middle_Index); 

else 

exit when {Middle_lndex = 

Outer_Index); 

Left_Index := 

Index’Succ(Middle_Index); 

end if; 
end loop; 

if Left_lndex /= Outer_Index then 

The_Iterns(Index'Succ(Left_Index) 

Outer_lndex) := 

The_Iterns (Lef t_Index .. 

Index'Pred(Outer_Index)); 

The_Iterns(Left_Index) := 

Temporary_Item; 

end if; 
end loop; 
end Sort; 

end Binary_Insertion_Sort; 


BINARY INSERTION SORT 
PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TyPE, 

Index : DISCRETE_TyPE, 

Items : ARRAY [ARRAY_ELEMENT : Item, ARRAY_INDEX 
Index], 

func_"<" : FUNCTION[Left : Item, Right : Item, 
RETURN : Boolean] 


INPUT 

The_Items : Items 
OUTPUT 

The_Iterns : Items 

END 

IMPLEMENTATION ADA Sort 
END 
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BUBBLE SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array {Index r^ge <>) of I tern; 
with function "<“ (Left : in Item; 

Right : in Item) return Boolean; 


package Bxibble_Sort is 

procedure Sort (The_ltems : in out Items); 
end Bubble_Sort; 


BUBBLE SORT 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is siabject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 
-- Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Bubble_Sort is 

procedure Sort (The_Items : in out Items) is 
Teirporary_Item ; Item; 

Exchanges_Made : Boolean; 
begin 


for Outer_Index in Index'Succ(The_Iterns’First) 
.. The_Items’Last loop 

Exchanges_Made := False; 

for Inner_Index in reverse Outer_Index .. 
The_Iterns'Last loop 

if The_Iterns(Inner_Index) < 

The_Iterns (Index' Pred{Inner_Index)) 

then 

Exchanges_Made True; 
Terrporary_Item : = 

The_Items (Index ’ Pred (Inner_Index)) ; 

The_Iterns(Index•Pred(Inner_Index)) 

The_Items(Inner_Index); 

The_Iterns(Inner_Index) := 

Teitporary^I tern; 

end if; 
end loop; 

exit when not Exchanges_Made; 
end loop; 
end Sort; 

end B\ibble_Sort; 


BUBBLE SORT 
PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TyPE, 

Index : DISCRETE_TYPE, 

Items : ARRAYIARRAY_ELEMENT : Item, ARRAY_INDEX 
Index], 

func_"<" : FUNCTION[Left : Item, Right : Item, 
RETURN ; Boolean] 


INPUT 

The_Iterns 
OUTPUT 

The_I terns 

END 


Items 

Items 


IMPLEMENTATION ADA Sort 
END 
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HEAP SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array (Index range <>) of Item; 
with fimction '<• (Left : in I tern; 

Right : in Item) return Boolean; 


package Heap_Sort is 

procedure Sort {The_Iterns : in out Items); 
end Heap_Sort; 


HEAP SORT 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Nxiinber 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in sxibdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Heap_Sort is 

procedure Sort (The_Items : in out Items) is 

Teinporary_Item : Item; 

Left_Index : Index; 

Right_Index : Index; 

procedure Sift (Left_Index ; Index; 

Right_Index : Index) is 
Tenporary_Item : Item : = 

The_Iterns(Left_Index); 

The_Front : Index := Left_Index; 

The_Back : Index ;= 

Index *Va1(Index'Pos(The_Front) * 2); 
begin 

while The_Back <= Right_Index loop 
if The_Back < RightsIndex then 
if The_ltems(The_Back) < 

The_Iterns(Index'Succ(The_Back)) 

then 

The_Back : = 

Index'Succ(The^Back); 


end if; 
end if; 

exit when not (Temporary_Item < 

The_Iterns{The_Back)); 

The_lterns(The_Front) := 

The_Iterns(The_Back); 

The_Front ;= The_Back; 
exit when (Index'Pos{The_Front) * 2 > 
Index'Pos(The_Iterns * Las t)) 

The_Back := 

Index’Val(Index'Pos{The_Front) * 2); 
end loop; 

The_Items(The_Front) := Temper ary_I tern; 
end Sift; 

begin 

Left_Index := 

Index' Val {((Index' Pos ('rhe_I terns ‘ Las t) - 

Index'Pos('Ihe_Items‘First) 1) 

2) + 1); 

Hight_Index := The_Iterns‘Las t; 
while Left_Index > The_Iterns'First loop 
Left_Index ;= Index'Pred{Le f t_lndex); 

Sift(Le ft_Index, Right_Index); 
end loop; 

while Right_Index > The_Iterns'First loop 
Terrrporary^Item : = 

The_Iterns (The_Iteins' First); 

The_Items(The_Items’First) := 

The_Items(Right^Index); 

The_l terns (Righ t_Index) ;= Tertporary_Item; 
Hight_Index := Index'Pred(Right_Index); 
Sift(Left_Index, Right_Index); 
end loop; 
end Sort; 

end Heap_Sort; 


HEAP SORT 
PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TyPE, 

Index : DISCRETE^TYPE, 

Items : ARRAY [ARRAy_ELEMENT : Item, AERAY_INDEX 
Index], 

func_"<" : FUNCTION[Left ; Item, Right : Item, 
RETURN ; Boolean] 


INPUT 

The_Items : Items 
OUTPUT 

The_Items : Items 

END 

IMPLEMENTATION ADA Sort 
END 
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NATURAL MERGE SORT 


generic 
type 
type 
with 
File) ; 

with 
File) ; 

with 

File; 

Item) ; 

with 

File; 

Item); 

with 
File) ; 


Item is private; 


procedure Open_For^Reading 

(The_File 

in out 

procedure Open_For_Writing 

(The_File 

in out 

procedure Get 

(The^File 

in out 


The_Item 

out 

procedure Put 

(The^File 

in out 


The_Item 

in 

procedure Close 

(The_File 

in out 


ADA SPECIFICATIONS 

with function Next_Item 
return Item; 

with function •<• 


return Boolean; 


return Boolean; 

package NaturalJMerge^Sort is 

procedure Sort (The_File 


File_Is_Empty : exception; 
end Natural_flerge_Sort; 


(The_File : 

in File) 

(Left : 

Right : 

in Item; 
in Item) 

(The^File : 

in File) 

: in out 
e_l : in out 
e_2 : in out 

File; 
File; 
File) ; 


NATURAL MERGE SORT 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Natural_Merge_Sort is 

procedure Sort (The^File 

Teit53orary_File_l 
TeOTporary_File_2 

Nuinber_Of_Runs ; Natural; 

procedure Copy {From_The_File : in out File; 

To_The_File : in out File; 

End_Of_R\m : out Boolean) 

is 

Temporary^!tern : Itern; 
begin 

Get (FronuThe^File, Teirporary_Itern) ; 

Put (To_The_File, Teitporary_Item) ; 
if Is_End_Of_File(From_The_File) then 
End_Of_Run := True; 

else 

End_0 f_Rxan : = {Next_I tem (Prom_The_Fi le) 
< Ten?>orary_Item) ; 

end if; 
end Copy; 


in out File; 
in out File; 
in out File) is 


File; 
File) is 


procedure Copy_Run (FroiiL_The_File : in out 
To_The_File : in out 
Boolean; 


End_Of_Run 
begin 

loop 

Copy{From_The_File, To_The_File, 

End_Of_Run) ,- 

exit when End^Of_Run; 
end loop; 
end Copy_Run; 


File 
File ; 
File) is 


procedure Merge_Run (Fron\_The_File : in out 

And_The_File ; in out 

To_The_File : in out 


End_0f_Run); 
To_The_File); 


End_Of_Run : Boolean; 
begin 

loop 

if not (Next_Item{And_The_File) < 

Next_Item(From_The_File)) then 
Copy (Froii\_The_File, To_The_File, 


if End_Of_Run then 

Copy_Run{And_The_File, 

exit; 
end if; 


End_0f_Run); 
To_The_File); 


Copy(And_The_File, To_The_File, 

if EndLOf_Run then 

Copy_Run(FronuThe_File, 


exit; 
end if; 
end if; 
end loop; 
end Merge_Rvm; 

begin 

loop 

Open_For_Reading(The_File); 
if Is_End_Of_File(The_File) then 
Close(The_File); 

Close (Tejiporary_File_l) ; 

Close (Teotporary_File_2) ; 
raise File„Is_Einpty; 

else 

Open_For_Writing(Tenporary_File_l); 
Open_For_Writing(Ten55orary_File_2) ; 

loop 

Copy_Run(The_File, To_The_File => 

Ternporary_File_l) ; 

if not Is_End_Of_File(The_File) 

then 

CopyJR\an{The_File, To_The_File 

=> Tenporary_File_2); 

end if; 

exit when Is_End_Of_File(The_File); 
end loop; 

Open_For_Writing{The_File); 
Open_For_Reading{Temporary_File_l}; 
Open_For_Reading(Temporary_File_2); 
Number_OfJRuns := 0; 
while (not 

Is_End_Of_File (Teiiporary_File_l)) and 
(not 

Is_End_Of_File {Teirporary_File_2)) loop 

Merge_Run(Temporary_File_l, 

Tenporary_File_2, 

To^The^File => The_File); 
Wumber_Of_Runs := Number_Of_Runs + 

1 ; 

end loop; 
while not 

Is_EndLOf_File(Tenporary_File_l) loop 

Copy_Riin {Teinporary_File_l, 
To_The_File => The_File); 

Number_Of_Rxms := Number_Of_Runs + 

1 ; 

end loop; 
while not 

Is_End_Of_File (Teo?3orary_File_2) loop 

Copy_Rtin(Teinporary_File_2, 
To_The_File => The_File); 

Number_Of_Runs := Niiinber_Of_Runs + 

1 ; 

end loop; 

exit when (Nuiriber_Of_Runs = 1); 
end if; 
end loop; 

Close(The^File); 

Close (Teirporary_File_l); 

Close(Temperary_File_2); 
end Sort; 

end Natural_Merge_Sort; 
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NATURAL MERGE SORT 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TyPE, 

File ; PRIVATE^TyPE, 

Open_For_Reading : PROCEDURE [The_File : in_outtt : 
File]], 

Open_For_Writing : PROCEDURE[The_File : in_out[t : 
File]], 

Get : PROCEDURE[The^File ; in_out[t : File], 
The_Item : out[t : Item]], 

Put : PROCEDUREIThe^File : in_outIt : File], 
The^Item : in[t : Item]], 

Close : PROCEDURE[The_File : in_out[t ; File]], 
Next_Item : FUNCTION I The_File : File, RETURN : 
Item], 

func_-<- : FUNCTION [Left : Item, Right : Item, 
RETURN : Boolean], 


PSDL 


Is_EncLOf_File : FUNCTION[The^File : File, RETURN 
Boolean] 

INPUT 

The_Pile : File, 

Tenporary_File_l : File, 

Temperary_File_2 : File 
OUTPUT 

The_File ; File, 

Terrporary_File_i : File, 

Teirporary_File_2 : File 
EXCEPTIONS 

File_Is_Ertpty 

END 

IMPLEMENTATION ADA Sort 
END 
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ORDERED SEQUENTIAL SEARCH 
ADA SPECIFICATIONS 


generic 

type Key is limited private; 
type Item is limited private; 
type Index is (<>); 

type Items is array(Index range <>) of Item; 
with function Is^Equal (Left : in Key; 

Right : in Item) return 


— adding procedures to replace f\mctions 

procedure Location_Of (The_Key : in Key; 

In_The_Iterns : in Items; 

Result : out Index) 

end of modification 


Boolean; 

with fxmction Is_Less_Than (Left 
Right 

Boolean; 

package OrderecLSequential_Search is 


in Key; 

in Item) return 


function Location_Of 
return Index; 


(The^Key : in Key; 

ln_The_Items : in Items) 


IteitLJNot_Found : exception; 


— modified by Tuan Nguyen 

— 20 Jan 95 


end Ordered_Sequential_Search; 


ORDERED SEQUENTIAL SEARCH 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989. 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Nurnber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

_restrictions as set forth in sribdivision (b) (3) 

-- of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Ordered_Sequential_Search is 

— modified by Tuan Nguyen 

— 20 Jan 95 

— adding procedures to replace functions 

procedure Location_Of (The_Key : in Key; 

In_The_Iterns : in Items; 


Result : out Index) is 

begin 

Result Location_0f{The_Key,In_The_Iterns); 

end Location_0f; 

— end of modification 

function Location_0f (The_Key ; in Key; 

In_The_Iterns : in Items) 

return Index is 
begin 

for The_Index in In_The_Iterns'Range loop 
if Is_Equal(The_Key, 

In_The_Iterns(The_Index)) then 

return The_Index; 
elsif Is__Less_Than(The_Key, 

In_The_I terns {The_Index) } then 

raise Item_Not_Found; 
end if; 
end loop; 

raise Iten\JJot_Found; 
end Location_Of; 

end Ordered_Sequential_Search; 


ORDERED SEQUENTIAL SEARCH 
PSDL 


OPERATOR Location_Of 
SPECIFICATION 
GENERIC 

Key : PRIVATE^TYPE, 

Item : PRi:VATE_TyPE, 
index ; DISCRETE_'IYPE, 

Items : ARRAY[ARRAY_ELEMENT : Item, ARRAY_INDEX : 
Index], . ^ 

Is_Equal : FUNCTION[Left : Key, Right : Item, 
return : Boolean] , . ^ 

Is_Less_Than : FUNCTION[Left : Key, Right : Item, 
RETURN : Boolean] 


INPUT 

The_Key : Key, 

In_The_Iterns : Items 
OUTPUT 

Result : Index 
EXCEPTIONS 

I terOIo t_Found 

END 

IMPLEMENTATION ADA Location_Of 
END 
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POLYPHASE SORT 


ADA SPECIFICATIONS 


generic 

Nuinber_Of_Files : in Positive; 


type 

Item is private; 




type 

File is limited private; 




with 

proced\ire Open_For_Reading 

(The_File 

: in 

out 

File); 



: in 


with 

procedure Open_For_Writing 

(The_File 

out 

File); 


(The_File 

: in 


with 

procedure Get 

out 

File; 







The_Item 

: out 

Item) ; 


(The_File 

in 


with 

procedure Put 

out 

File; 


The_Item 

in 


Item) ; 





with 

procedure Close 

(The_File 

in 

out 


with function Next_Item {FronuThe_File : in 

File) return Item; 

with function "<• (Left ; in 

I tern; 

Right : in 

Item) return Boolean; 

with function Is_EncLOf_File (The^File : in 

File) return Boolean; 
package Polyphase_Sort is 

type Files is array (1 .. Number_Of_Files) of File; 

procedure Sort (The_File : in out File; 

Ten^orary_Files ; in out Files; 

Sorted_File : out Positive); 

File_Is_Enipty : exception; 

end Polyphase_Sort; 


POLYPHASE SORT 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Nximber 0100219 


•Restricted Rights Legend“ 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package bo<^ Polyphase_Sort is 


is 


procedure Sort (The_File 

Teitpor ary_Fi les 
Sorted_File 


in out File; 
in out Files; 
out Positive) 


Number_Of_Runs 
Nuirber_0 f_F i les) o f Natural ; 

Nuinber_0 f_Duinrt^_Runs 
N\jmb€r_0 f_F i les) o f Natural ; 
Last_Item 

Nuirb€r_Of_Files) of Item; 

Filejflap 

Nuinber_Of_Files) of Positive; 

Available_Files 
Nturiber_Of_Files) of Positive; 
Level 

Output_File 

Number^O f^va i lable^F iles 

Last_^File 

Last^Runs 

Las t_Duiraiy_Runs 


array (1 .. 

array (1 .- 

array (1 .. 

array (1 .. 

array (1 .. 

Natural := 1; 
Natural := 1; 
Natural; 
Positive; 
Natural; 
Natural; 


procedure Select__File is 

Temporary^Rvin : Natural ; 
begin 

if Nuinber_Of_Duminy_Runs (Output_File) < 
Number^O f_Duinnv__Runs (Ou tpu t_Fi le + 1) 

then 

Output_Pile := Output_File + 1; 

else 

if N\iinber_Of_Duinmy_Runs (Output_File) = 

0 then 

Level := Level + 1; 

Teinporary_R\in : = Nimiber_Of_R\ms {1); 
for Index in 1 .. (Nuitber_Of_Files 


- 1) loop 

Number_Of _Duinn^_Runs (Index) : = 
Tenporary_Run + 
Number_Of_Runs(Index +1) - 

Number_Of_Runs(Index); 
Nuinber_0 f_^uns (Index) : 
Temporary_Run + 

Number_Of_Runs(Index +1); 

end loop; 
end if; 

Output_File := 1; 
end if; 

Nximber^Of_Dumtny_Runs (Ou tpu t_Fil e) :« 
N\i(nber_Of_Dumirv_Runs {Output_F i le) - 1 ; 
end Select_File; 


procedure Copy_Run is 

Teii?3orary_Item : Item; 
begin 

loop 

Get(The_File, Tenporary_Item}; 
Put(Tenporary_Files(Output_File), 

Temporary_Item); 

exit when (Is_End^Of_File(The_.File> or 

else 

{Next_ltem(The_File) < 

Ten55orary_Item)) ; 

end loop; 

Last_Item{Output_File) := Teit 5 >orary_Item; 
end Copy_Run; 


procedure Merge_Run is 

File_Index : Positive; 

Smallest_Itern : Item; 

Smallest^File : Positive; 

Tenporary_ltem : Item; 

EncLOf_File : Boolean; 
begin 

loop 

Number_Of^vailable_Files ; = 0; 

for Index in 1 ., (Nuinber_Of_Files - 1) 

loop 

if Nvimber_Of_Dummy_Runs(Index) > 0 

then 

Nuinber_Of_Dumttiy_Rtans (Index) : = 
Number_Of_Dumitv_Runs (Index) - 


1 ; 


1 ; 


Number^Of_Avai lable^F i 1 es : *= 
Nvimber_Of^vailable_Files 


Available^Files (Number_Of^vailable_Files) : = 

FileJMap(Index); 
end if; 
end loop; 

if Number_Of_Available_Files = 0 then 

Nxamber^Of_.Duinmy_R\ms (Number_0 f_Fi les) : = 

Number_OfJDuinitry_Runs (Number_Of_Files) + 1; 
else 

loop 

File_Index := 1; 

Sinallest_File := 1; 
Smallest_Item : = 

Next_Item 


(Temporary_Files(Available_File5(l))) ; 

while File_Index < 
Number_Of_Available_Files loop 

File_Index ;= File_Index + 


1 ; 


Teinporary_I tern 
Next_Item 


(Tenporary_Files (Available_Files (File_Index))) ; 

if Teitporary_Item < 

Smallest_Item then 

Smallest_ltem := 

Tenporary_I tem; 

Smallest_File := 

File_Index; 

end if; 
end loop; 
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Get (Ten 5 )orary_Files (Available^Files (Smallest_File)), 
Tennporary^Item); 
En<3L0f_File : = 

Is_End_Of_File 

{Tenporary_Files(Available_Files(Smallest^File))); 

Put (Teitporary_Files (File_Hap (Nuiriber_Of_Files)), 
Tenipora^_Item); 
if End_Of_File or else 
(Next^Item 

(Teitiporary_Files(Available_Files(Smallest_File))) 

< Temperary^Item) then 

Available_Files(Smallest^File) := 

Available_Files(Number_Of_Available_Files}; 

Nuihber_Of _Avai 1 ab le__Fi le s 


Nuinber_Of_Available_Files - 1; 

end if; 
exit when 

(Nuinl>er_Of^vailable_Files = 0); 

end loop; 
end if; 

Last_Runs := Last_Runs - 1; 
exit when (Last^Runs = 0); 
end loop; 
end Merge_Run; 


for Index in 1 .. {Nuinber_Of__Files - 1) loop 
Nuiriber_0 f_Runs(Index) := 1; 

Number_0 f _Duiratv_Runs (Index) : = 1; 
Open_For_Writing(Teit?)orary_Files(Index)) ; 
end loop; 

Nutnber_Of_Runs {N\ainber_Of_Files) : = 0 ; 

Nuniber_Of_Diimmy_Runs (Nuitiber_Of_Files) 0; 
Open^For_Reading{The_File); 
if Is_End_Of_File(The_File) then 

for Index in 1 .. Nxmiber_Of_Files loop 
Close (Teinporary_Files (Index)); 
end loop; 

Close(The^File); 
raise File_Is_Enpty; 

else 

loop 

Select_File; 

Copy_Run; 

exit when (Is_En<l_Of_File{The_File) or 
{Output_File = 

(Nuiriber_Of_Files - 1))) ; 

end loop; 

while not Is_End_Of_File(The_File) loop 
Select_File; 

if not (Next_Item{The_File) < 

Last_Itern {(Xitput_File)) then 
Copy_Run; 

if Is_End_Of_File(The_File) then 


Number„0 f_Duinn^_Runs (Output_Fi le) ; = 

Nuinber_Of„Duininy_Runs{Output_File) + 1; 
else 

Copy_Run; 
end if; 

else 

Copy„Run; 
end if; 
end loopy- 
close (The^File) ; 

for Index in 1 .. {Nuinber_Of_Files “ 1) 

loop 

Open_For_Reading(Teniporary_Files(Index)) ; 

end loop; 

for Index in 1 .. N\jmber„Of_Files loop 
File_Map(Index) := Index; 

end loopy- 
loop 

Last^Runs := 

Number_Of_R\ins (Nuinber_Of_Files - 1) ; 

Number_Of_Duinmy-_Runs (Number_Of_Files) 

:= 0; 

Open_For_Writing (Tert^Jorary^Files {File Jlap (Nuinber_Of_Fil 
es))); 

Merge_Run; 

Open_For_Reading (Terrporary_Files (File_JMap (Nuinber_Of_Fil 

^ ^' Last_File : = FileJMap (Nuinber_Of_Files) ; 

Last_Duinnv-Rvins : = 

Number_Of_!Xunrry_Rxms(Number_Of_Files) ; 

*” Last_Runs : = 

Number_Of__Runs (Nuinber_Of_Files - 1) ; 

for Index in reverse 2 .. 
Number_Of_Files loop 

File_Wap(Index) := FileJMap(Index - 

1 ) ; 

Number_0 f_Runs(Index) : = 

Nuinber_Of_R\ins(Index “1) - 

Last^Runs; 

Nuniber_Of_Duintny_Runs (Index) : = 
Nuinber_Of_Dximiny_Rtins (Index - 1) ; 
end loop; 

Filejlap(l) := Last^File; 
Nuinber_Of_Runs(l) := Last_Runs; 
Niunber_Of _.r>umrtV'_RiJ^s (1) : = 

Last_DuiniivJRuns ; 

Level := Level - 1; 
exit when (Level = 0); 
end loop; 

for Index in 1 .. Number_Of_Files loop 
Close(Temporary_Files(Index)); 
end loop; 

Sorted^File FileJIapd); 
end if; 
end Sort; 

end Polyphase_Sort; 


POLYPHASE SORT 
PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

File : PRIVATE_TTfPEy 

Open_For_Reading : PROCEDURE[The^File ; in_out[t : 

^^^^Open_For_Writing : PROCEDURE[The_File : in_out(t : 

Get : PROCEDUREIThe_File ; in_out[t : File), 
The_Item : out[t : Item]], 

Put : PROCEDURE(The_File : in_OUt[t : File], 
The^Item : in[t : Item]], 

Close : PROCEDURE[The_File : in_OUt[t : File]], 
Next_Item : FUNCTION[FronL.The_File : File, RETURN : 
Item], 


func_"<* : FUNCTIONlLeft : Item, Right : Item, 
RETURN :~Boolean], 

IS_End_Of_File : FUNCTION(The^File : File, RETURN 
Boolean] 

INPUT 

The_File : File, 

Tertporary_Files : Files 
OUTPUT 

The_File : File, 

Temporary_Files : Files, 

Sorted_File : Positive 
EXCEPTIONS 

File_Is_Empty 

END 

mPLEKENTATION ADA Sort 
END 
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QUICKSORT 

ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array (Index range <>) of I tern ; 
with function (Left : in Item; 

Right : in Item) return Boolean; 


package Quick_Sort is 

procedure Sort (The^Iterns ; in out Items); 
end Quick_Sort; 


QUICKSORT 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 


"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S, Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Quick_Sort is 


procedure 3Sxchange (Left ; in out Item; 

Right : in out Item) is 
Tenporary_Item ; I tern; 
begin 

Temporary_Item := Left; 

Left := Right; 

Right : = Teiiporary_Item; 
end Exchange; 


procedure Sort (The_Iterns ; in out Items) is 
procedure Sort_Recursive (Left_Index : in 


Index; 


Right„Index ; in 


Index) is 

Pivot_Item : Item; 

The^Front : Index; 

The_Back ; Index; 

Middle_Index ; Index; 

begin 

if Left^Index < Right_Index then 
Middle_lndex := 

Index•Val((Index•Pos(Left_Index) + 


Index ’ Pos (Right_Index)) / 2) ; 

if The_Items{Middle_Index) < 

The_Iterns(Left_Index) then 

Exchange (The_Iterns (Middle,.Index), 
The_Iterns (Lef t^Index)) ; 

end if; 

if The^Items(Right_Index) < 

The_Items (Left_Index) then 

Exchange(The_Iterns(Right^Index), 
The_Items (Lef t_Index)} ; 

end if; 

if The_Items(Right_Index) < 

The^Items (Middle_Index) then 


Exchange (The„Items (Right_Index), 
The_Items (Middle_Index)) ; 

end if; 

Pivotal tern The_Items (Middle_Index) ; 
Exchange (The,.Items (Middle_Index), 


The_Iterns (Index' Pred(Right,..Index))); 

The_Front := Index•Succ(Left_Index); 
The_Back := Index'Pred(Right^Index); 
if The„Back /= The_Iterns‘First then 
The_Back := Index *Pred(The_Back); 
end if; 
loop 

while The_Iterns(The_Front) < 

Pivot_Item loop 

The_Front := 

Index'Succ(The_Front); 

end loop; 

while Pivotaltern < 

The_Items(The_Back) loop 

The_Back := 

Index‘Pred(The_Back); 

end loop; 

if The_Front <« The^Back then 

if (The_Front = The_Iterns'Last) 


or else 
then 


(The_Back = The_Iterns'First) 
return; 

else 


Exchange(The_Iterns(The^Front), 

The^Iteins (The^Back)); 

The_Front := 

Index'Succ(The_Front); 

The,^ack : = 

Index' Pred(The..Back); 

end if; 
end if; 

exit when (The_Front > The_Back); 
end loop; 

Sort_Recursive(Left_Index, The_Back); 
Sort_Recursive{The_Front, Right_Index); 
end if; 

end Sort_Recursive; 
begin 

Sort_Recursive{The_Iterns'First, 

The_Iterns'Last); 
end Sort; 

end Quick_Sort; 


QUICKSORT 

PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_nfPE, 

Index : DISCRETE_TYPE, 

Items : ARRAY [ARRAY_ELEMENT ; Item, ARRAY_INDEX 
Index], 

func_"<" : FUNCTIONlLeft : Item, Right : Item, 
RETURN : Boolean) 


INPUT 

The_Items : Items 
OUTPUT 

The_It€ms : Items 

END 

IMPLEMENTATION ADA Sort 
END 
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RADIX SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>}; 

type Items is array{Index range <>) of Item; 

Number_Of_Key_Bits : in Positive; 

with function Bit_Of (The_Item ; in Item; 


The^Bit : in Positive) 

return Boolean; 
package Radix_Sort is 

procedure Sort (The^Items : in out Items); 

end Radi3;_Sort; 


RADIX SORT 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 


— Serial Number 0100219 

“Restricted Rights Legend* 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Computer 

-- Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Radix_Sort is 


procedure Sort {The_Items : in out Items) is 
procedure Sort^Recursive (Left_Index : in 


Index; 


Right_Index : in 


Index; 


Bit : in 


Positive) is 

Temperary_Left : Index; 
Tenporary_Right : Index; 

Temperary_Itern : Item; 
begin 

if Right_Index > Left_Index then 
Temporary_Le ft := Left_Index; 
Tenporary^ight ;= Rights Index; 
loop 

while (not 

Bit_Of(The_Items(Teiiporary_Left) , Bit)) and 
{Teirporary_Left < 

Tenporary^Right) loop 

Temporary_Left := 

Index' Succ {Tenporary_,Lef t) ; 

end loop; 


while 

(Bit_ 0 f(The_Items(Temporary_Right), Bit)) and 
(Tenporary_Left < 

Temperary_Right) loop 

Tenporary_Right := 

Index'Pred(Temperary_Right); 

end loop; 

Teirporary_Item : = 

The_Iterns (Tenporary_Lef t) ; 

The_Iterns(Tenporary_Left) : = 
The_Iterns{Temporary_Right) ; 

The_I terns (Tenporary_Righ t) : = 


Temporary_I tern; 

exit when {Tenporary_Left = 

Temporary_Right); 

end loop; 

if not Bit_Of(The„Iterns(Right_Index), 

Bit) then 

Teirporary_Right : = 

Index'Succ(Temperary_Right); 

end if; 

if Bit < Number_Of_Key_Bits then 
if Temperary_Right > 

The_.Iterns'First then 

Sort_Recursive 
(Left_Index, 

Index’Pred(Tenporary_Right), Bit 1); 

end if; 

Sort_Recursive 

(Temporary_Right, Right_Index, 


Bit + 1); 


end if; 
end if; 

end Sort_Recursive; 


begin 

Sort_Recursive(The_Iteins'First, The_Iterns 'Last, 
end Sort; 


end Radix_Sort; 


QUICKSORT 

PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item ; PRIVATE^IYPE, 

Index : DISCRETE_TyPE, 

Items : ARRAYtARRAY^ELEMENT : Item, ARRAY_INDEX 
Index], 

Bit_Of ; FUNCTION[The_Itern : Item, The_Bit ; 
Positive, RETURN : Boolean] 


INPUT 

The_Items : Items 
OUTPUT 

The_Iterns : Items 

END 

IMPLEMENTATION ADA Sort 
END 
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SEQUENTIAL SEARCH 
ADA SPECIFICATIONS 


generic 

type Key is limited private; 
type Item is limited private; 
type Index is {<>); 

type Items is array(Index range <>) of Itern; 
with function Is_Equal (Left : in Key; 

Right : in Item) return 

Boolean; 

package Sequential_Search is 


procedure Location__Of 


(The^Key 
In_The_I terns 
Result 


in Key; 
in I terns; 
out Index); 


— end of modification 
function Location_Of 
return Index; 


(The_Key : in Key; 

In_The_Iterns : in Items) 


— modified by Tuan Nguyen 

— 20 Jan 95 

— adding procedures to replace functions 


ItenuNot_Found : exception; 
end Sequential_Search; 


SEQUENTIAL SEARCH 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is sxabject to 

— restrictions as set forth in subdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Coir 5 >uter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Sequential_Search is 

— modified by Tuan Nguyen 

— 20 Jan 95 

— adding procedures to replace fiinctions 

procedure Location_0f (The^Key ; in Key; 


In_The_Iterns : in Items; 
Result : out Index) is 

begin 

Result : = Location_0f (The_Key, In_The_Iterns); 
end Location^Of; 

— end of modification 

function Location_Of (The^Key : in Key; 

In_The_Iterns : in Items) 

return Index is 
begin 

for The^lndex in In_The_Iterns'Range loop 
if Is_Equal(The_Key, 

In_The_Iterns(The_Index)) then 

return The_Index; 
end if; 
end loop; 

raise Item_Not_Found; 
end Location_Of; 

end Sequential^Search; 


SEQUENTIAL SEARCH 
PSDL 


OPERATOR Location_Of 
SPECIFICATION 
GENERIC 

Key : PRIVATE.TYPE, 

Item ; PRIVATE.TyPE, 

Index : DISCRETE^TYPE, 

Items : ARRAYIARRAY_ELEMENT : Item, ARRAY_INDEX 

Index], 

Is_Equal ; FUNCTION[Left ; Key, Right : Item, 
RETURN : Boolean] 

INPUT 


The_Key : Key, 

In_The_Iterns : Items 
OUTPUT 

Result : Index 
EXCEPTIONS 

11 emJ^o t_Found 

END 

IMPLEMENTATION ADA Location^Of 
END 
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SHAKER SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array(Index range <>) of Item; 
with function "<" (Left : in Item; 

Right : in Item) return Boolean; 


package Shaker_Sort is 

procedure Sort (The_Iterns : in out Items); 
end Shaker_Sort; 


SHAKER SORT 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in sxibdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


package body Shaker_Sort is 


procedure Sort (The_Iterns : in out Items) is 
Teitporary^Item : Item; 

Teiiporary__Index : Index; 

Left_Index : Index; 

Right_Index : Index; 

begin 

Le f t_Index := Index'Suec(The_Iterns’First); 

Right_Index := The_Iterns‘Last; 

loop 

for Middle_Index in reverse Left_Index .. 
Right_Index loop 

if The_Items(Middle_Index) < 

The_Iterns(Index‘Pred(Middle_Index)) 


then 


Temperary_Itern 

The_Items(Index'Pred(Middle_Index)); 

The_I terns (Index ’ Pred (Middle_Index)) 

The_I terns (Middle_Index) ; 

The_Iterns{Middle_Index) := 

Terrporary„I tem; 

Teirporary_Index := Middle_Index; 
end if; 
end loop; 

Left_Index := Index'Succ(Temperary_Index); 
for Middle^Index in Left^Index .. 
Right_Index loop 

if The_Iterns (Middle^Index) < 

The_Iterns (Index' Pred (Middle_Index}) 

then 

Temporary_Item := 

The_Items(Index'Pred{Middle_Index)); 

The_Items (Index • Pred (Middle^Index)) 

The_I terns {Middle_Index) ; 

The_I terns (Middle_Index) : = 

Tertpor ary_I t em; 

Terrporary_Index := Middle_Index; 
end if; 
end loop; 

Right_Index ;= Index * Pred(Temporary_Index); 
exit when (Left_Index > Right_Index); 
end loop; 
end Sort; 

end Shaker_Sort; 


SHAKER SORT 
PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE, 

Index : DISCRETE^TYPE, 

Items : ARRAY [ARRAY_ELEMENT : Item, ARRAY_INDEX 
Index), 

func_‘<" : FUNCTION [Left : Item, Right ; Item, 
RETURN : Boolean) 


INPUT 

The_Items : Items 
OUTPUT 

The_Iterns : Items 

END 

IMPLEMENTATION ADA Sort 
END 
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SHELL SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array(Index range <>) of Itern; 
with fxinction "<“ (Left : in Item; 

Right : in Item) return Boolean; 


package Shell_Sort is 

procedure Sort (The_Items ; in out Items); 
end Shell_Sort; 


SHELL SORT 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Nurciber 0100219 

"Restricted Rights Legend* 

— Use, duplication, or disclosure is siibject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data cind Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Shell_Sort is 

procedure Sort {The_Iterns : in out Items) is 
Ten 5 >orary_Item : I tern; 

Inner_Index : Index; 

Increment : Positive 1; 

begin 

loop 

exit when (((9 * Increment) + 4) >= 

(Index’Pos(The_Iterns'Last) - 
Index'Pos(The^Items'First) + 1)); 

Increment := (3 * Increment) + 1; 
end loop; 
loop 

for Outer_Index in 


Index‘Val(Index'Pos(The_Iterns‘First) + 

Increment) .. 

The_Iterns'Last loop 
Teii 5 >orary_Item : = 
The_Items(Outer_lndex) ; 

Inner_Index := Outer_Index; 
while Teirporary_Item < 

The_Iterns(Index•Val(Index'Pos(Inner_Index) - 
Increment)) 

loop 

The_Iterns(Inner^Index) ;= 


The_It ems(Index'Val{Index'Pos(Inner_Index) - 
Increment)); 

Inner_Index := 

Index * Val{Index•Pos(Inner_Index) 


- Increment) ; 


exit when (Index'Pos(Inner_lndex) - 


Increment < 


Index'Pos(The_Items'First)); 

end loop; 

The_Iterns(Inner_Index) := 

Teinporary_Item; 

end loop; 

exit when (Increment =1); 
Increment := (Increment - 1) / 3; 
end loop; 
end Sort; 


end Shell^Sort; 


SHELL SORT 
PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE, 

Index : DISCRETE.IYPE, 

Items : ARRAY [ARRAY^ELEMENT ; Item, ARRAY^INDEX 
Index), 

func_“<" : FUNCTIONtLeft : Item, Right : Item, 
RETURN : Boolean] 


INPUT 

The^Items : Items 
OUTPUT 

The_Items : Items 

END 

IMPLEMENTATION ADA Sort 
END 
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STRAIGHT INSERTION SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array(Index range <>) of Item; 
with function "<" (Left : in Item; 

Right : in Item) return Boolean; 


package Straight_Insertion_Sort is 

procedure Sort (The_Items : in out Items); 
end Straight_Insertion_Sort; 


STRAIGHT INSERTION SORT 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

— "Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Coirputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Straight_Insertion_Sort is 

procedure Sort (The„Iterns : in out Items) is 
Temporary_Item : Item; 


Inner_Index : Index; 
begin 

for Outer_Index in Index•Succ(The_Items'First) 
.. The_Iterns'Last loop 

Tenporary^Item := The_Iteins(Outer_Index) ; 
Inner_Index ;= Outer_Index; 
while Teitporary_Item < 

The_Iterns(Index'Pred{Inner_Index)) loop 

The_I terns (Inner_Index) : = 

The_Iterns(Index•Pred(Inner_Index)); 

Inner_Index := Index'Pred(Inner_Index) 
exit when (lnner_Index = 

The_Items'First); 

end loop; 

The_Items{Inner_Index) := Temporary_ltem; 
end loop; 
end Sort; 

end Straight_Insertion_Sort; 


STRAIGHT INSERTION SORT 
PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

Index : DISCRETE_TYPE, 

Items : ARRAY [ARRAY_ELEMENT : Item, ARRAY_INDEX 
Index], 

func_"<" : FUNCTIONILeft : Item, Right : Item, 
RETURN : Boolean] 


INPUT 

The_Iterns : Items 
OUTPUT 

The_Iterns : Items 

END 

IMPLEMENTATION ADA Sort 
END 
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STRAIGHT SELECTION SORT 


ADA SPECIFICATIONS 


generic 

type Item is private; 
type Index is (<>); 

type Items is array(Index range <>) of Item; 
with function "<• (Left : in Item; 

Right : in Item) return Boolean; 


package Straight_Selection_Sort is 

procedure Sort {The_Items : in out Items); 
end Straight_Selection_Sort; 


STRAIGHT SELECTION SORT 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52,227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Straight_Selection«Sort is 

procedure Sort (The_Items ; in out Items) is 
Temper ary_I tern : I tern; 

Tenporary_Index : Index; 


begin 

for Outer_Index in The_Iterns'First .. 

Index’Preddhe^Iterns‘Last) loop 

Tenporary_Index := Outer_Index; 
Tenporary^Item := The^Iterns (Outer_Index) ; 
for lnner_Index in Index'Suec(Outer_Index) 
.. The_Iterns'Last loop 

if The^Items(Inner_Index) < 

Temperary_Itern then 

Teirporary_Index := Inner_Index; 
Tertporary_ltem : = 

The_Items(Inner_Index); 

end if; 
end loop; 

The_Iteins (Tenporary_Index) : = 

The_Iterns(Outer_Index); 

The_I terns (Outer_Index) := Teitporary_Item,- 
end loop; 
end Sort; 

end Straight_Selection_Sort; 


STRAIGHT SELECTION SORT 


PSDL 


OPERATOR Sort 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TyPE, 

Index : DISCRETE^TyPE, 

Items : ARRAY [ARRAY_ELEMENT : Item, ARRAY_INDEX 
Index!, 

func_"<" : FUNCTION[Left : Item, Right ; Item, 
RETURN : Boolean) 


INPUT 

The_Iterns : Items 
OUTPUT 

The_Iterns ; Items 

END 

IMPLEMENTATION ADA Sort 
END 
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STACK 0JB3 SPECIFICATION 


obj STACK[X :: TRIV] is sort Stack . 
protecting NAT . 

*** constructors 


op create 

: -> Stack . 

op copy 

; Stack Stack -> Stack 

op clear 

; Stack -> Stack . 

op push 

: Elt Stack -> Stack . 

op pop 

: Stack -> Stack . 

r accessors 


op isequal 

; Stack Stack -> Bool . 

op depthof 

: stack ••> Nat . 

op isen^ty 

: Stack -> Bool . 

op topof 

: Stack -> Elt . 


*** exceptions 

op overflow : -> Stack . 


op underflow : --> Stack . 
op underflow ; -> Elt . 

*** variables declaration 

var S SI ; Stack . 
var E El : Elt . 

*** axioms 

eq clear(S) = create . 
eq copy{S,SI) = S . 
eq pop (create) = xinderflow . 
eq pop(push(E,S)) = S . 
eq isequal(S,S1) = S =« SI . 

eq depthof(S) s= if S == create then 0 else 1 + depthof (pop (S)) fi . 
eq isempty(S) = if S == create then true else false fi . 
eq topof(create) = underflow . 
eq topof(push(E,S)) = E . 

endo 
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STACK PROFILE CODES 


OPERATORS 

SIGNATURES 

PROFILE CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

PUSH 

AB->B 

3211 

POP 

A->A 

2201 

IS_EQUAL 

AB->C 

330 

DEPTH.OF 

A->B 

220 

IS.EMPTY 

A->B 

220 

TOP_OF 

A->B 

220 


SET OF PROFILE: {3211,2201,330,220} 
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STACK SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA SPECIFICATION 


generic 

type Item is private; 

package Stack_Sequential_Bounded_ManagecLIterator is 

type Stack{The^Size : Positive) is limited private; 

procedure Copy {From„Th©_Stack : in Stack; 

To_The_Stack : in out Stack); 
procedure Clear {The^Stack : in out Stack); 

procedure Push (The_Item ; in Item; 

On_The_Stack : in out Stack); 
procedure Pop (The^Stack : in out Stack); 

— modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_Equal (Left : in Stack; 

Right : in Stack; 

Result : out Boolean); 

procedure Depth_Of (The_Stack ; in Stack; 

Result : out Natural); 

procedure Is^Empty (The^Stack ; in Stack; 

Result : out Boolean); 

procedure Top_0£ (The_Stack ; in Stack; 

Result : out Item); 

— end of modification 

function Is_Equal (Left : in Stack; 


Right : in Stack) return 

Boolean; 

function Depth_Of (The_Stack : in Stack) return 
Natural; 

function Is_Eiipty (The_Stack : in Stack) return 
Boolean; 

function Top_Of (The^Stack : in Stack) return 
I tern ; 

generic 

with procedure Process (The_Item : in Itern; 

Continue : out 

Boolean); 

procedure Iterate (Over_The_Stack : in Stack); 

Overflow : exception; 

Underflow : exception; 

private 

type Items is array(Positive range <>) of Item; 
type Stack(The_Size : Positive) is 
record 

The_Top : Natural := 0; 

The_Items : Items(1 .. The_Size); 
end record; 

end Stack_Sequential_Bounded_jManaged_Iterator; 
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STACK SEQUENTIAL BOUNDED MANAGED ITERATOR 
ADA IMPLEMENTATION 


— <C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Ntimber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in sxabdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Cocrputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 
Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Stack_Sequential_BoundedJlanagecaLIterator 
is 

procedure Copy (FroauThe^Stack : in Stack; 

To_The_Stack : in out Stack) is 

begin 

if Froit\_The_Stack.The_Top > 
To_The_Stack.The_Size then 
raise Overflow; 

else 

To_The_Stack. The_Iterns (1 .. 
Froin_The_Stack.The_Top) : = 

FrottL,The_Stack. The„I terns {1 .. 

Fron\_The_Stack. The_Top); 

To_The_Stack.The_Top := 

Frortu.The_St ack. The_Top ; 
end if; 
end Copy; 

procedure Clear (The_Stack : in out Stack) is 
begin 

The_Stack.The_Top := 0; 
end Clear; 

procedure Push (The^Item : in Item; 

On_The_Stack : in out Stack) is 

begin 

On_The_S tack. The_I terns (On_The_S t ack. The_Top + 
1) := The_Item; 

On_The_Stack.The_Top := On_The_Stack.The_Top + 

1; 

exception 

when Constraint_Error => 
raise Overflow; 
end Push; 

procedure Pop (The_Stack ; in out Stack) is 
begin 

The_Stack. The_Top ;= The_Stack. The_Top - 1; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

— modified by Tuan Nguyen 

— replacing procedures with frmctions 

procedure Is_Equal (Left : in Stack; 

Right ; in Stack; 

Result : out Boolean) is 

begin 

Result := ls_Equal (Left,Right) ; 
end ls_Equal; 

procedure Depth_Of (The_Stack : in Stack; 


Result : out Natural) is 

begin 

Result ;= Depth_Of (The_Stack) ; 
end DepthL.Of; 

procedure Is_Eo 5 >ty (The_Stack : in Stack; 

Result : out Boolean) is 

begin 

Result Is_Empty(The_Stack); 
end Is_Errpty; 

procedure Top_Of (The^Stack ; in Stack; 

Result ; out Item) is 

begin 

Result ;= Top_Of{The_Stack); 
end Top_Of; 

— end of modification 

function Is^Equal (Left : in Stack; 

Right : in Stack) return Boolean 
is 

begin 

if Left.The_Top /= Right.The^Top then 
return False; 

else 

for Index in 1 .. Left.The_Top loop 
if Left.The_Iterns(Index) /= 

Right - The_I terns (Index) then 

return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 

function Depth_Of (The_Stack ; in Stack) return 
Natural is 
begin 

return The_Stack.The_Top; 
end Depth_Of; 

function Is_Empty (The_Stack ; in Stack) return 
Boolean is 
begin 

return (The_Stack.The_Top =0); 
end Is_Errpty; 

function Top_Of (The^Stack ; in Stack) return Item 
is 

begin 

return The_Stack.The_Items(The_Stack.The_Top) ; 
exception 

when Constraint__Error => 
raise Underflow; 
end Top_Of; 

procedure Iterate (Over_The_Stack : in Stack) is 
Continue : Boolean; 
begin 

for The_Iterator in reverse 1 ., 
Over_The_Stack.The_Top loop 

Process{Over_The_Stack.The_Iterns(The^Iterator), 
Continue); 

exit when not Continue; 
end loop; 
end Iterate; 

end Stack_Seguential_BoundedJIanagecLIterator; 


STACK SEQUENTIAL BOUNDED MANAGED ITERATOR 


PSDL 


TYPE S t ack_Sequent ial_Bounde<UJanage<3_I t er a tor 
SPECIFICATION 
GENERIC 

Item : PRXVATEJTYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroitL.The_Stack : Stack, 

To_The_Stack : Stack 
OUTPUT 

To_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Stack ; Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Push 
SPECIFICATION 
INPUT 

The_Item : Item, 

On_The_Stack : Stack 
OUTPUT 

On_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Stack, 

Right : Stack 
OUTPUT 


Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Depth^Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Err?>ty 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDUREfThe_Itern : in[t 

Continue : out[t : Boolean]] 

INPUT 

Over_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

S t ack_Sequent ial_Bounded_Jlanaged_I tera tor 

END 


Item], 
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STACK SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

package Stack_Sequential_Unbounded_ManagedLNoniterator 
is 

type Stack is limited private; 

procedure Copy (FronuThe_Stack ; in Stack; 

To_The_Stack ; in out Stack); 
procedure Clear (The_Stack ; in out Stack); 

procedure Push (The_Item : in Itern; 

On_The_Stack ; in out Stack); 
procedure Pop (The_Stack : in out Stack); 

— modified by Tuan Nguyen 

— replacing functions with procedures 

procedure ls_Equal (Left : in Stack; 

Right : in Stack; 

Result : out Boolean); 

procedure D€pth_Of (The_Stack ; in Stack; 

Result ; out Natural); 
procedure Is^Empty (The_Stack : in Stack; 


Result ; out Boolean); 
procedure Top_Of (The^Stack : in Stack; 

Result : out Item) ; 

— end of modification 

ftinction Is_Egual {Left : in Stack; 

Right : in Stack) return 

Boolean; 

function Depth_Of (The_Stack : in Stack) return 
Natural; 

fimction Is_Enpty (The_Stack ; in Stack) return 
Booleein; 

function Top_Of (The_Stack : in Stack) return 
Item; 

Overflow ; exception; 

Underflow : exception; 

private 

type Node; 

type Stack is access Node; 
end Stack_Seq[uential_Unbounded_Jlanaged_Noniterator; 
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STACK SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989. 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) 
{ii) 

— of the rights in Technical Data and Computer 
Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with StorageJlanager_Sequential; 
package body 

Stack_Sequential_Unbounded_Jlanaged_Noniterator is 

type Node is 
record 

The_Item : Itern; 

Next : Stack; 

end record; 

procedure Free (TheJNode : in out Node) is 
begin 

null; 
end Free; 

procedure Set_Next (The_Node : in out Node; 

To^Next ; in Stack) is 

begin 

The_Node.Next := ToJIext; 
end Set_Next; 


begin 

Terrporary_Node Node_Nanager .New_Item; 
Tertporary_Node.The_Item The_Item; 
Temperary_Node.Next ;= On_The_Stack; 
On_The_Stack := Temporary_JJode; 
exception 

when Storage_Error => 
raise Overflow; 
end Push; 

procedure Pop (The_Stack : in out Stack) is 
Teitporary^Node : Stack; 
begin 

Temperary_Node := The_Stack; 

The_Stack := TenporaryJIode-Next; 
Teiiporary_Jlode.Next ;= null; 

Node_Manager.Free(Temporary_Node); 
exception 

when Constraint„Error => 
raise Underflow; 

end Pop; 

modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_Equal (Left : in Stack; 

Right : in Stack; 

Result ; out Boolean); 

procedure Depth_Of (The_Stack : in Stack; 

Result : out Natural) 

procedure Is^Eopty (The_Stack ; in Stack; 

Result ; out Boolean); 

procedure Top_Of (The_Stack : in Stack; 

Result ; out Item); 

end of modification 


function Next_Of (The_JJode : in Node) return Stack 
l>egin 

return The_Node.Next; 
end Next_Of; 


package Node_Manager is new 
S t orage_Manage r_Sequentia1 

Node, 


(Item => 

Pointer => 


Stack, 

Free -> Free, 

Set_Pointer => SetJMext, 
Pointer_Of => Next_Of); 


procedure Copy (From_The_Stack : in Stack; 

To_The_Stack : in out Stack) is 
FrortL.Index : Stack := FronuThe.Stack; 

To_Index : Stack; 
begin 

NodeJManager.Free(To_The_Stack); 
if FrortuThe_Stack /- null then 

To_The_Stack NodeJlanager.New_Item; 
To_The_Stack.The_Item : = 

Froin_Index. The_I tern; 

To_Index := To_The_Stack; 

Froirulndex := From_Index.Next; 
while From_Index /= null loop 

To_Index. Next : = Node^Manager. New„Item; 
To^lndex := To_Index.Next; 
To_Index.The_Item 
From_Index.The_Itern; 

FronL.Index := From_Index.Next; 
end loop; 
end if; 
exception 

when Storage^Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Stack ; in out Stack) is 
begin 

Node_Manager.Free(The_Stack); 
end Clear; 

procedure Push (The_Item : in Item; 

On_The_Stack : in out Stack) is 
TemporaryJNTode : Stack; 


function Is_Equal (Left ; in Stack; 

Right : in Stack) return Boolean 
is 

Left^Index ; Stack := Left; 

Right_Index : Stack := Right; 
begin 

while Left_Index /= null loop 
if Left_Index.The„Item /= 
Right_Index.The_Item then 

return False; 
end if; 

Left_Index := Left_Index.Next; 

Right_Index ;= Right_Index. Next; 
end loop; 

retum (Right_Index = null) ; 
exception 

when Constraint^Error => 
return False; 
end Is_Equal; 

function Depth^Of (The_Stack : in Stack) return 
Natural is 

Count : Natural := 0; 

Index : Stack ;= The_Stack; 
begin 

while Index /= null loop 
Count := Coxjnt + 1; 

Index Index.Next; 
end loop; 
return Count; 
end Depth_Of; 

function Is_Enpty (The_Stack : in Stack) return 
Boolean is 
begin 

return (The„Stack = null); 
end Is_Empty; 

function Top_0f (The_Stack : in Stack) return Item 
is 

begin 

re turn The_S tack.The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_0f; 

end stack_Sequential_UnboundedJManaged_Noniterator; 
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STACK SEQUENTIAL UNBOUNDED MANAGED NONITERATOR 

PSDL 


TYPE Stack_Sequential_Unbounded^anagecLNoniterator 
SPECIFICATION 

GENERIC 

Item : PRIVATE.TypE 

OPERATOR Copy 

SPECIFICATION 

INPUT 

Froiru.The_Stack : Stack, 

To_The_Stack : Stack 
OUTPUT 

To_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Push 

SPECIFICATION 

INPUT 

The_Item ; Item, 

On_The_Stack : stack 
OUTPUT 

On_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 


OPERATOR IS_Egual 

SPECIFICATION 

INPUT 

Left : Stack, 

Right : Stack 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Depth_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Enpty 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

S tack_Sequent ial_UnboundecLManaged_Noni ter at or 
END 
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STACK SEQUENTIAL UNBOUNDED MANAGED ITERATOR 
ADA SPECIFICATION 


generic 

type Item is private; 

package stack_Sequential_Unboundedl_Managed_Iterator is 


type Stack is limited private; 


procedure Copy (Froitv_'rhe_Stack : in Stack; 

To_The_Stack 

: in out Stack) 

procedure Clear (The_Stack 

: in out Stack) 

procedure Push {The_Item 

: in Item; 

On_The_Stack 

: in out Stack) 

procedure Pop (The_Stack 

: in out Stack) 

modified by Tuan Nguyen 

replacing functions with procedures 

procedure Is_Equal (Left 

in Stack; 

Right 

in Stack; 

Result 

out Boolean); 

procedure Depth__Of (The^Stack 

: in Stack; 

Result 

: out Natural); 

procedure Is^Enpty (The_Stack ; 

in Stack; 

Result : 

out Boolean); 

procedure Top_Of (The_Stack : 

in Stack; 

Result : 

out Item); 


end of modification 


function Is_Equal 
Boolean; 

function Depth^Of 
Natural; 

function Is_Eiripty 
Boolean; 

function Top_Of 
Item; 


(Left 

Right 

(The_Stack 

(The_Stack 

(The_Stack 


in 

in 

Stack; 

Stack) 

return 

in 

Stack) 

return 

in 

Stack) 

return 

in 

Stack) 

return 


generic 

with procedure Process (The_Item : in Itern; 

Continue : out 

Boolean); 

procedure Iterate {Over_The_Stack : in Stack); 


Overflow : exception; 
Underflow : exception; 


private 

type Node; 

type Stack is access Node; 
end Stack_Sequential_Unbotmded_ManagecLIt€rator; 
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STACK SEQUENTIAL UNBOUNDED MANAGED ITERATOR 
ADA IMPLEMENTATION 


-- (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

-- restrictions as set forth in subdivision (b) (3) 
(ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Sequential; 
package body 

Stack_Sequential_UnboundecLNanagecLIterator is 


exception 

when Storage_Error => 
raise Overflow; 
end Push; 

procedure Pop (The_Stack ; in out Stack) is 
TemporeiryJHode : Stack; 
begin 

Teitporary_Node := The_Stack; 

The_Stack := Tenporary_^ode.Next; 
Tercporary^Node.Next ; = null; 
Node_Manager.Free(TemporaryJNode) ; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

modified by Tuan Nguyen 
replacing ftmctions with procedures 


type Node is 
record 

The_Item ; Item; 

Next ; Stack; 

end record; 

procedure Free (The_Node : in out Node) is 
begin 

null; 
end Free; 

procedure SetJtJext {TheJNode : in out Node; 

To_Next : in Stack) is 

begin 

The^Node.Next := To_Next; 
end SetJNext; 

function Next_0f (The_JJode : in Node) return Stack 
begin 

return The_Node.Next; 
end Next_Of; 


package Nodejlanager is new 
S t or age_Manager_Sequen t ial 

Node, 


(Item => 

Pointer => 


Stack, 

Free => Free, 

Set_Pointer => Set_Next, 
Pointeract => Next_0f); 


procedure Copy (From_The_Stack : in Stack; 

To_The_Stack : in out Stack) is 
From_Index : Stack := From_The_Stack; 

To_Index ; Stack; 
begin 

Node_Manager. Free {To_The_Stack) ; 
if From_The_Stack /= null then 

To_The_Stack ;= Node_Manager .New_Item; 
To_The_Stack.The_Item ;= 

From_lndex. The_„I tem; 

To_Index := To_The_Stack; 

From_Index ;= From_Index.Next; 
while Fronuindex /* null loop 

To_Index,Next := Node^anager.New^Item; 
To_Index := To_Index.Next; 

To_Index.The_Item ;= 

From_lndex.The^Item; 

Fronuindex := From_Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Clear (The_Stack : in out Stack) is 
begin 

Node_Manager. Free {The_S tack) 
end Clear; 


procedure Push ('Ilie_Item : in I tern; 

On_The_Stack ; in out Stack) is 
TemporaryJMode : Stack; 
begin 

Temporary_Node := Node_Manager .New^Item; 
Terrporary_Node.The_Item := The_Item; 
Temporary_Node.Next := On_The_Stack; 
On_The_Stack := TenporaryJNode; 


procedure Is_Equal (Left : in Stack; 

Right : in Stack; 

Result : out Boolean); 

procedure DepthjOf (The_Stack : in Stack; 

Result : out Natural); 
procedure Is^Empty {The_Stack : in Stack; 

Result : out Boolecin) ; 

procedure Top_0f (The_Stack : in Stack; 

Result : out Item); 

— end of modification 

function Is_Equal (Left : in Stack; 

Right : in Stack) return Boolean 
is 

Left_Index ; Stack ;= Left; 

Right_Index : Stack := Right; 
begin 

while Left_Index /= null loop 
if Left_Index.The_Item /= 
Right_Index.The_Item then 

return False; 
end if; 

Left_Index Left_Index.Next; 

Right_Index ;= Right_Index.Next; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint^Error => 
return False; 
end ls_Equal; 

function Depth_0f (The_Stack : in Stack) return 
Natural is 

Count : Natural := 0; 

Index : Stack := The_Stack; 
begin 

while Index /= null loop 
Coxint ;= Count + 1; 

Index := Index .Next; 
end loop; 
return Count; 
end Depth_Of; 

fxmction Is_Ertpty (The_Stack : in Stack) return 
Boolean is 
begin 

return (The_Stack = null); 
end Is^Enpty; 

function Top_Of (The_Stack ; in Stack) return Item 
is 

begin 

return The_Stack.The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_Of; 

procedxrre Iterate (Over_The„Stack : in Stack) is 
The_Iterator : Stack := Over_The_Stack; 

Continue : Boolecin; 

begin 

while not (The_Iterator » null) loop 

Process(The_Iterator.The_Item, Continue); 
exit when not Continue; 

The_Iterator := The^Iterator.Next; 
end loop; 
end Iterate; 

end S tack_Secauential_UnboundedJlanageci_I terator ; 
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STACK SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

PSDL 


TYPE Stack_Seguential_Uribounded_Managec5LIterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroirL_The_Stack ; Stack, 

To_The_Stack ; Stack 
OUTPUT 

To_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Push 
SPECIFICATION 
INPUT 

The_Item : Item, 

On_The_Stack : Stack 
OUTPUT 

On_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Stack, 

Right ; Stack 
OUTPUT 


Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Depth.Of 

SPECIFICATION 

INPUT 

The_Stack ; Stack 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR IS^Eopty 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The^Stack : Stack 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Itern : in[t : 

Continue : out[t : Boolean]] 

INPUT 

Over_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Stack_Sequential_Unboiinde<OIanaged_Iterator 

END 


Item], 
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STACK SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATION 


generic 

type Item is private; 
package 

Stack_Seguential_Unboxmded^Unmanaged_Noniterator is 
type Stack is limited private; 

procedure Copy {Fronu.The_Stack : in Stack; 

To_The_Stack : in out Stack); 
procedure Clear (The_Stack : in out Stack); 

procedure Push (The^Item ; in Item; 

On_The_Stack : in out Stack); 
procedure Pop {The_Stack : in out Stack); 

— modified by Tuan Nguyen 

— replacing functions with procedures 

procedure Is_Eciual (Left : in Stack; 

Right : in Stack; 

Result : out Boolean); 

procedure Depth^Of (The_Stack ; in Stack; 

Result : out Natural); 

procedure Is_Empty (The_Stack : in Stack; 


Result : out Boolean); 
procedure Top_Of (The_Stack : in Stack; 

Result : out Item); 

— end of modification 

function Is^Equal (Left : in Stack; 

Right : in Stack) return 

Boolean; 

function Depth_Of (The_Stack : in Stack) return 
Natural; 

function Is_En 5 )ty (The_Stack ; in Stack) return 
Boolean; 

f\inction Top_Of (The^Stack : in Stack) return 
Item; 

Overflow : exception; 

Underflow : exception; 

private 

type Node; 

type Stack is access Node; 

end S t ack_Sequential_Unbounded_Uninanaged_Noni terator; 
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STACK SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in srabdivision (b) (3) 

(ii) 

--of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body 

Stack_Sequential_Unbounded_UnitianagedLJMoniterator is 

type Node is 
record 

The_Item : Item; 

Next ; Stack; 

end record; 


procedure Copy (From_The_Stack : in Stack; 

To_The_Stack : in out Stack) is 
Fronulndex : Stack FrorruThe_Stack; 

To^Index : Stack; 
begin 

if From_The_Stack = null then 
To_The_Stack := null; 

else 

To_The_Stack := new Node*{The_Item => 
From_Index. The_Item, 

Next => 

null); 

To_Index := To_The_Stack; 

From_Index From_Index-Next ; 
while Fronuindex /= null loop 

To_Index.Next := new Node' (The_Item => 
From_Index. The_Item, 

Next => 

null); 

To_Index := To_Index.Next; 

FronL-Index ;= From_Index.Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Stack ; in out Stack) is 
begin 

The_Stack := null; 
end Clear; 


procedure Push (The_Item : in Item; 

On_The_Stack : in out Stack) is 

begin 

On_The_Stack ;= new Node' (The_Item => The_Item, 


Next => 


On_The_Stack) ; 
exception 

when Storage_Error => 
raise Overflow; 


end Push; 


procedure Pop (The_Stack : in out Stack) is 


begin 

The_Stack := The_Stack.Next; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 

— modified "by Tuan Nguyen 

— replacing fxinctions with procedures 

procedure Is_Equal (Left : in Stack; 

Right ; in Stack; 

Result ; out Boolean); 

procedure Depth_Of (The^Stack : in Stack; 

Result : out Natural); 

procedure Is_Eicpty (The_Stack : in Stack; 

Result : out Boolean); 

procedure Top_0f {The_Stack : in Stack; 

Result : out Item); 

— end of modification 


function Is_Equal (Left : in Stack; 

Right : in Stack) return Boolean 
is 

Left_Index : Stack Left; 

Right_Index : Stack := Right; 
begin 

while Left_Index /= null loop 
if Left_Index.The_Item /= 

Right_Index-The_Itern then 

return False; 
end if; 

Left^Index := Left_Index.Next; 

Right^Index := Right_Index.Next; 
end loop; 

return (Right_Index = null); 
exception 

when Constraint_Error => 
return False; 
end Is_Equal; 

ftinction Depth_Of (The_Stack ; in Stack) return 
Natural is 

Count : Natural := 0; 

Index : Stack := The_Stack; 
begin 

while Index /= null loop 
Count := Count + 1; 

Index := Index.Next; 
end loop; 
return Co\int; 
end Depth_0f; 

function Is_Eirpty (The_Stack ; in Stack) return 
Boolean is 
begin 

return ('Ihe_Stack = null) ; 
end Is_En 5 >ty; 

function Top_0f (The_Stack : in Stack) return Item 
is 

begin 

return The_Stack.The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_Of; 

end Stack_Se( 3 uential_Unboimded_UnmanagedJJoni terator; 
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STACK SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

PSDL 


TYPE Stack_Sequential_Unbounded_UnitianagedLNoniterator 
SPECIFICATION 

GENERIC 

Item : PRIVATE.TYPE 

OPERATOR Copy 

SPECIFICATION 

INPUT 

FronL_The_Stack : Stack, 

To__The_Stack : Stack 
OUTPUT 

To_The_Stack ; Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Push 

SPECIFICATION 

INPUT 

The_Item ; Item, 

On_The_Stack : Stack 
OUTPUT 

On_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 


OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left ; Stack, 

Right : Stack 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Depth^Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result ; Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is^Empty 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Stack_Sequential_UnbotindedJJnmanaged_Noniterator 

END 
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STACK SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 
ADA SPECIFICATION 


generic 

type Item is private; 

package Stack_SequentialJcrnboxindedLUninanaged_Iterator 
is 


type Stack is limited private; 


procedure Copy (From_The_^Stack : in Stack; 

To_The_Stack 

; in out Stack); 

procedure Clear (The_Stack 

: in out Stack); 

procedure Push {The_Item 

: in I tern; 

On_The_Stack 

; in out Stack); 

procedure Pop {The_Stack 

: in out Stack); 

modified by Tuan Nguy^ 

replacing functions with procedures 

procedure ls_Egual (Left 

: in Stack; 

Right 

: in Stack; 

Result 

: out Boolean); 

procedure Depth_Of (The_Stack 

: in Stack; 

Result 

; out Natural) ; 

procedure Is_Enpty (The_Stack 

: in Stack; 

Result 

; out Boolean); 

procedure Top_Of (The_Stack : 

in Stack; 

Result : 

out Item); 


end of modification 


function Is^Egual 
Boolean; 

fimction Depth^Of 
Natural; 

function ls_Enpty 
Boolean; 

function Top_Of 
Item; 


(Left 

Right 

{The_Stack 

(The_Stack 

{The_Stack 


in Stack; 
in Stack) return 

in Stack) return 

in Stack) return 

in Stack) return 


generic 

with procedure Process (The_Item : in Item; 

Continue ; out 

Boolean); 

procedure Iterate {Over_The_Stack : in Stack); 


Overflow : exception; 
Underflow : exception; 


private 

type Node; 

type Stack is access Node; 

end Stack_Sequential_Unbounded_Uninanaged_Iterator; 


262 




STACK SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Number 0100219 

“Restricted Rights Legend* 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in siibdivision (b) (3) 

<ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 


modified by Tuan Nguyen 
replacing functions with procedures 

procedure Is_Equal (Left : in Stack; 

Right ; in Stack; 

Result ; out Boolean); 

procedure Depth_Of (The_Stack : in Stack; 

Result : out Natural); 
procedure Is_Eitpty {The_Stack ; in Stack; 

Result : out Boolean); 

procedure Top_Of (The^Stack ; in Stack; 

Result : out Item); 

end of modification 


package body 

StacK-Sequential_Unbounded_Unmanaged_Iterator is 

type Node is 
record 

The_Item : Item; 

Next : Stack; 
end record; 

procedure Copy (Front-The^Stack ; in Stack; 

To_The_Stack : in out Stack) is 
Fronulndex : Stack := Front.The_Stack; 

To_Index : Stack; 
begin 

if Froii\_The_Stack = null then 
To_The_Stack := null; 

else 

To_The_Stack ;= new Node' (The_Item => 
From_Index.The_Item, 

Next => 

null); 

To_Index := To_The_„Stack; 

Fronuindex := From^Index.Next; 
while Fron\_Index /- null loop 

To_Index.Next := new Node' (The_Item => 
Fromulndex. The_I tern. 

Next => 

null); 

To^Index := To_Index.Next; 

From_Index := From_Index,Next; 
end loop; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The_Stack : in out Stack) is 
begin 

The_Stack := null; 
end Clear; 


procedure Push {The_Item : in Item; 

On_The_Stack : in out Stack) is 

begin 

On_The_Stack ;= new Node' (The_Item => The_Item, 
Next => 


On_The_Stack); 
exception 

when Storage_Error => 
raise Overflow; 
end Push; 


procedure Pop (The_Stack : in out Stack) is 
begin 

The_Stack := The_Stack.Next; 
exception 

when Constraint_Error => 
raise Underflow; 

end Pop; 


function Is_Equal (Left : in Stack; 

Right : in Stack) return Boolean 
is 

Left^Index ; Stack ;= Left; 

Right_Index : Stack := Right; 
begin 

while Left_Index /= null loop 
if Left_Index.The_Item /= 

Right_Index.The_Itern then 

return False; 
end if; 

Left^Index := Left_Index.Next; 

Right^Index Right_Index.Next; 

end loop; 

retircn (Right_Index = null); 
exception 

when Constraint_Error -> 
return False; 
end Is_Equal; 

fxinction Depth_Of (The_Stack : in Stack) return 
Natural is 

Count ; Natural := 0; 

Index : Stack := The_Stack; 
begin 

while Index /- null loop 
Count := Covint + 1; 

Index ;= Index.Next; 
end loop; 
return Count; 
end Depth^Of; 

function Is^Empty (The_Stack : in Stack) return 
Boolean is 
begin 

return (The_Stack = null); 
end Is_Empty; 

function Top_Of (The^Stack : in Stack) return Item 
is 

begin 

return The_Stack.The_Item; 
exception 

when Constraint_Error => 
raise Underflow; 
end Top_Of ; 

procedure Iterate (Over_The_Stack : in Stack) is 
The_Iterator : Stack := Over_The_Stack; 

Continue : Boolean; 

begin 

while not (The_Iterator = null) loop 

Process{The_Iterator.The_Itern. Continue); 
exit when not Continue; 

The_Iterator := The_Iterator.Next; 
end loop; 
end Iterate; 

end Stack_Sequential_Unbounded_Unmanaged_Iterator; 
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STACK SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

PSDL 


TYPE Stack_Sequential_Unbo\indecLUninanaged_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPXJT 

FrottuThe_Stack ; Stack, 

To_The_Stack : Stack 
OUTPUT 

To_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Push 
SPECIFICATION 
INPUT 

The_Item : Item, 

On_,The_Stack : Stack 
OUTPUT 

On_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Pop 
SPECIFICATION 
INPUT 

The_Stack : Stack 
OUTPUT 

The_Stack ; Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Stack, 

Right : Stack 


OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Depth_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Is_Einpty 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Top_Of 

SPECIFICATION 

INPUT 

The_Stack : Stack 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Underflow 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDXJRE[The_Item : in It : Item] 
Continue : outIt : Boolean]] 

INPUT 

Over_The_Stack : Stack 
EXCEPTIONS 

Overflow, Underflow 

END 

END 

IMPLEMENTATION ADA 

Stack_Sequential_Unbounded_Unmanaged_Iterator 
END 
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STORAGE MANAGER SEQUENTIAL 


ADA SPECIFICATION 


generic 

type Item is limited private; 
type Pointer is access Item; 

with procedure Free (The_Item : in out 

Item) ; 

with procedure Set^Pointer (The^Item : in out 
I tern; 

The_Pointer : in 

Pointer); 

with function Pointer^Of (The^ltem : in Item) 
return Pointer; 

package StorageJManager_Sequential is 


procedure Free (The_Pointer : in out Pointer); 

— modified by Tuan Nguyen 

— replace function with procedure 

procedure New_Item (Result : Pointer); 

— end of modification 

function New_Item return Pointer; 
end Storage_Manager_Sequential; 
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STORAGE MANAGER SEQUENTIAL 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady 
Booch 

— All Rights Reserved 

— Serial Nuinber 0100219 

“Restricted Rights Legend" 

— Use, duplication, or disclosure is sxibject to 

— restrictions as set forth in sxabdivision (b) (3) 

(ii) 

— of the rights in Technical Data and Coit^suter 

— Software Clause of FAR 52.227-7013- Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body Storage_Mcinager_Sequential is 
Free_List : Pointer ;= null; 

procedure Free {The_Pointer : in out Pointer) is 
Tenporary^Pointer : Pointer; 
begin 

while The_Pointer /= null loop 

Terrporary_Pointer : = The_Pointer ; 

The_Pointer := Pointer_Of(The_Pointer.al1); 
Free (Ternporary_Pointer. all) ; 

Set_Po inter (Terrporary_Pointer, all, 
The_Pointer => Free_List); 

Free_List := Ten?>orary_Po inter; 


end loop; 
end Free; 

— modified by Tuan Nguyen 
replace function with procedure 

procedure New^Iteiti (Result : Pointer) is 
begin 

Result New_Item; 
end New_Item; 

— end of modification 

function New_ltem return Pointer is 
Tenporary^Pointer : Pointer; 
begin 

if Free_List = null then 
return new Item; 

else 

Teraporary_Pointer := Free_List; 
Free_List := 

Pointer_Of(Tenporary_Pointer.all); 

Set_Pointer (Tert5)orary_Po inter. all, 
The_Pointer => null); 

return Ten?)orary_Pointer ; 
end if; 
end New_Item; 

end Storage_Manager_Seguential; 
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STORAGE MANAGER SEQUENTIAL 


PSDL 


OPERATOR Free 
SPECIFICATION 
GENERIC 

Item : PRIVATE.TYPE, 

Pointer : ACCESS.TYPE, 

Free : PROCEDURE[The_Itern : in_out[t : Item]], 
Set^Pointer ; PROCEDURE[The_Itern : in^outlt : 
Item], The^Pointer : in[t : Pointer]], 

Pointer_Of : FUNCTION[The_Itern ; Item, RETURN : 
Pointer] 


INPUT 

The_Pointer : Pointer 
OUTPUT 

The_Pointer : Pointer 

END 


IMPLEMENTATION ADA Free 
END 


267 



STRING SEQUENTIAL UNBOUNDED CONTROLLED ITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type Substring is array(Positive range <>) of Item; 
with function "<" (Left : in Item; 

Right : in Item) return Boolean; 
package String_Sequential_UnboundecLControlled^lterator is 


type String is limited private; 


procedure Copy 

procedure Copy 

procedure Clear 
procedure Prepend 

procedure Prepend 

procedure Append 

procedure Append 

procedure Insert 

procedure Insert 

procedure Delete 

procedure Replace 

procedure Replace 

procedure Set_Item 


{FroituThe_String 
To_The_S tring 
{Fr onL.The_Subs t r ing 
To_The„S tring 
(The_String 
{The_String 
To_The_S tring 
{The_Subs tring 
To_The_S tring 
(The_String 
To_The_String 
{The_Substring 
To jrhe_S tring 
(The_String 
In_The_String 
At_The_Position 
(The^Substring 
In_The_String 
At_The_Position 
{In_The_String 
FronL.The_Pos i t ion 
To_The_Position 
(In_The_String 
At_The_Position 
With_The_S tring 
(Injrhe_String 
At_The_Position 
Wi th_The_Subs tring 
{In_The_String 
At_The_Position 
With_The_Item 


in 

String; 

in out 

String); 

in 

Substring; 

in out 

String); 

in out 

String); 

in 

String; 

in out 

String); 

in 

Siibs tring ; 

in out 

String); 

in 

String; 

in out 

String); 

in 

Substring; 

in out 

String); 

in 

String; 

in out 

String; 

in 

Positive); 

in 

Substring; 

in out 

String; 

in 

Positive); 

in out 

String; 

in 

Positive; 

in 

Positive); 

in out 

String; 

in 

Positive; 

in 

String); 

in out 

String; 

in 

Positive; 

in 

Substring) 

in out 

String; 

in 

Positive; 

in 

Item); 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace f\mctions 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Is_Equal 

(Left 

in String; 

Right 

in String; 


Result 

out Boolean); 

Is_Equal 

(Left 

in Substring; 

Right 

in String; 


Result 

out Boolean); 

Is_Equal 

(Left 

in String; 

Right 

in Substring; 


Result 

out Boolean); 

Is_Less_Than 

(Left 

in String; 


Right 

in String; 


Result 

out Boolean); 

Is_Less_Thcui. 

(Left 

in S\ibstring; 

Right 

in String; 


Result 

out Boolean); 

Is_Less_Than 

(Left 

in String; 


Right 

in Substring; 


Result 

out Boolean); 

Is_Greater_Than 

(Left 

in String; 


Right 

in String; 


Result 

out Boolean); 

Is_Greater_Than 

(Left 

in Substring; 


Right 

in String; 


Result 

out Boolean); 

IsjGreater_Than 

(Left 

in String; 


Right 

in Substring; 


Result 

out Boolean); 


procedure Length_Of 

(The_String 

; in String; 

Result 

: out Natural) ; 

procedure Is_Null 

(The_String 

: in String; 

Result 

: out Booleein) ; 

procedure Item_Of 

(The^String 

: in String; 

At_The_Position 

: in Positive; 


Result 

: out Item) ; 

procedure Substring_Of 

(The_String 

: in String; 

Result 

: out Substring); 

procedure Substring_Of 

(The_String 

: in String; 

From_The_Position 

: in Positive; 


To_The_Position 

: in Positive; 


Result 

: out Substring); 

— end of modification 

function Is^Equal 

(Left ; 

in String; 

Right : 

in String) return 

Boolean; 

function Is_Equal 

(Left : 

in Substring; 

Right : 

in String) return 

Boolean; 

function Is_Equal 

(Left ; 

in String; 

Right : 

in Substring) return 

Boolean; 

function Is_Less_Than 

(Left ; 

in String; 


Right ; 

in String) return 

Boolean; 

function Is_Less_Than 

(Left : 

in Substring; 

Right : 

in String) return 

Boolean; 

function Is_Less_Than 

(Left : 

in String; 

Right : 

in Sxdsstring) return 

Boolean; 

function Is_Greater_Thcm 

(Left : 

in String; 


Right : 

in String) return 

Boolean; 

function Is_Greater„Than 

(Left : 

in Sijbstring; 


Right : 

in String) return 

Boolean; 

fxinction Is_Greater_Than 

(Left : 

in String; 


Right : 

in Substring) return 

Boolean; 

function Length_Of 

(The_String : 

in String) return 

Natural; 

ftmction Is_Null 

(The_String : 

in String) return 

Boolean; 

fxinction Item_Of 

(The_String : 

in String; 

At_The_Position ; 

in Positive) return 

Item; 

function Substring__Of 

(The_String ; 

in String) return 

Siibs tring; 

function Substring_Of 

(The^Strxng ; 

in String; 


Fron\JI^e_Position : 

in Positive; 


To_The_Position : 

in Positive)return 


Substring; 


generic 

with procedure Process (The_Item : in Item; 

Continue : out Boolean); 

procedure Iterate {Over_The_String : in String); 

Overflow ; exception; 

Position_Error : exception; 

private 

type Structure is access Substring; 
type String is 
record 

The_Length : Natural := 0; 

The_Items : Structure; 
end record; 

end String_Seguential_Unbounded_Controlled_Iterator; 
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STRING SEQUENTIAL UNBOUNDED CONTROLLED ITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nimber 0100219 

"Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in svibdivision (b) (3) (ii) 

— of the rights in Technical Data and Con 5 )uter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Storage_Manager_Se( 3 uential; 

package body String_SequentialJUnboimde<l_Controlled_Iterator is 
type Node; 

type Node_Pointer is access Node; 
type Node is 
record 

The_Structure : Structure; 

Next : Node_Pointer; 

end record; 

type Header; 

type Header_Pointer is access Header; 
type Header is 
record 

The^Size : Natural; 

The_Structures : Node^Pointer; 

Next : Header_Pointer; 

end record; 

procedure Free(The_Node ; in out Node) is 
begin 

The_Node.The_Structure := null; 
end Free; 

procedure Set_Next (The^Node : in out Node; 

To_Next : in Node__Pointer) is 

begin 

TheJMode. Next : = ToJNext; 
end SetJNext; 

function Next_Of (The_Node : in Node) return Node_Pointer is 
begin 

return The_Node.Next; 
end Next_Of; 

package Node_Manager is new Storage_Manager_Sequential 

(Item => Node, 

Pointer *=> Node_Pointer, 

Free => Free, 

Set_Pointer => Set_Next, 

Pointer_Of => Next_Of); 

procedure Free(The_Header : in out Header) is 
begin 

The_Header.The_Size 0; 
end Free; 

procedure Set_Next {The_Header : in out Header; 

To^Next : in Header_Pointer) is 

begin 

The_Header.Next := To_Next; 
end SetJNext; 

function Next_Of (The_Header : in Header) return Header_Pointer is 
begin 

retuzm The_Header.Next; 
end Next_Of; 

package Header_Manager is new Storage_Manager_Sequential 

(Item => Header, 

Pointer => Header_Pointer, 

Free => Free, 

Set^Pointer => SetJNext, 

Pointer_Of => Next_0f); 

task StructureJManager is 

entry Free {The_Structure : in out Structure) ; 

entry Get^ew_Structure (The^Size : in Natural; 

The_Structure : out Structure); 

end StructureJManager; 

task body StructureJManager is 

Free_List : Header_Pointer; 

The_Structure : Structure; 

Node_Index : Node_Po inter; 

Previous_Header : Header_Pointer; 

Header_Index : Header_Pointer; 

begin 

loop 

begin 

select 

accept Free (The_Structure : in out Struct\ire) do 
Previous_Header := null; 

Header_Index := Free_List; 


while Header_lndex /= null loop 
if The_Structure‘Length < 

Header_Index. The_Si ze then 
exit; 

elsif The_Stxructure‘Length = 
Header_Index.The„Size then 

Node_Index := NodeJManager .New_Item; 
Node_Index.The_Structure := 


The_Structure; 


Header^Index.The^Structures; 


Node_Index; 


Node_Index.Next := 

Header^Index.The_Strue tures i~ 


The^Strueture := null; 
return; 
end if; 

Previous_Header := Header_Index; 
Header_Index : = Header_Index. Next; 
end loop; 

Header^Index := Header^Manager .NewjItem; 
Header_Index.The_Size := The_S true ture'Length; 
Node_Index := Nodejlanager .New_Item; 
Node_Index.The_Strue ture ;= The_Strueture; 
Header_Index. The_S true tures : = Node_Index ; 
if Previous_Header = null then 

Header_Index.Nex t := Free_Lis t; 

Free_List := Header_Index; 

else 

Header_Index.Next := Previous_Header.Next; 
Previous_Header.Next ;= Header_Index; 
end if; 

The_Structure := null; 
end Free; 


Structure) do 


Header^Index,The_Struetures; 
Node_Index.Next; 


accept GetJIew_Strueture (The_Size : in 

The_Structure : out 

Previous_Header := null; 

Header_Index := Free_List; 
while Header_Index /= null loop 

if Header_Index.The_Size >= The^Size then 
Node^Index := 


Header_Index.The_Structures : = 


Node_Index.Next :s= null; 
if Header_Index.The_Struetures = null 


Header_Index. Next; 


Node_Index.The_Struc ture; 


if PreviousJHeader = null then 
Free_List := 

else 

Previous_Header.Next := 
Header^Index.Next; 
end if; 

Header_Index.Next := null; 
Header_Manager .Free{Header_Index); 
end if; 

The_S true ture ; = 


Nodejlanager.Free(Node_Index); 
return; 
end if; 

PreviousJieader := Header_Index; 
Header_Index := Header_Index.Next; 
end loop; 

The„Structure :=; new Substring (1 .. Ihe^Size); 
end Get_New_Structure; 


terminate; 
end select; 
exception 

when Storage„Error «> 
null; 

end; 

end loop; 

end Structurejianager; 

procedure Free (The_Strueture ; in out Structure) is 
begin 

if The_Structure /= null then 

Structure_Manager.Free(The_S trueture); 
end if; 
end Free; 

function New_Structure (The_Size : in Natural) return Structure is 
Teitporary_Structure : Structure; 
begin 

StructureJManager .GetJIewjS true ture (The_Size, 

Tenporary_S true ture); 

return Teitporary_S true ture; 
end New_Strueture; 

procedure Set {The_String : in out String; 

Tojrhe_Size ; in Natural; 

Preserve_The_Value : in Boolean) is 

Tenporary_Strueture : Structure; 
begin 
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if To_The_Size = 0 then 

Free(The_String.The„Iterns); 
elsif The_Strxng.The_Iteins = null then 

The_String.The_Iterns := New_Structure(The_Sxze => 
To_The_Size); ^ 

elsif To_The_Size > The_String.The_Iterns'Length then 
if Preserve_The„Value then 

Temporary's true ture ;= New_S trueture{To_The_Size); 
Teirporary^S true ture (1 . . The_S tr ing. The_Length) : = 
The_String.The_Iteins(l .. The_String.The_Length); 
Free(The_String.The_Items); 

The_String,The_Iterns ;= Temporary_Strueture; 

else 

Free(The_String.The_Iterns); 

The_String.The_Items := New_Strueture 

(The_Size => To_The_Size); 


end if; 
end if; 

The_String.The„Length 
exception 

when Storage_Error => 
raise Overflow; 


To_The_Size; 


end Set; 


procedure Copy (From_The_String : in String; 

To_The_String : in out String) xs 

begin 

Set{To_The_String, ^ 

To_The_Size => Froitu.The_String.The_Length, 

Preserve_The_Value -> False); 

To The String.The.Itemsd .. FronuThe_String.The_Length) 

FronuThe^S tring. The_I terns (1 .. FronuThe_S tring. The^Length) ; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 


procedure Copy (From_The_Substring : in Sxibstring; 

To_The_String : in out String) is 

begin 

Set (To_The_S tring, , . , 

To_The_S i ze => Froin_The_Subs tring * Leng th, 

Preserve_The_Value => False); 

To_The_S tring. The_I terns (1 . . Fr orrL.The_Subs t r xng' Leng th) ; = 
From_The_Subs tring ; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear (The„String : 
begin 

Set(The_String, 

To_The_Size -> 

Preserve_The_Value => 
exception 

when Storage_Error => 
raise Overflow; 
end Clear; 


in out String) is 
0 , 

False); 


procedure Prepend {The_String : in String; ^ 

To_The_String : in out String) is 
Old^Length : Natural := To_The_S tring .The^Length; 

New_Length : Natural := . t 

To_The_Str ing. The_Length + The_S tring, The^Length; 


begin 

Set(To_The_String, 

To_The_Size => New_Length, 

Preserve_The_Value => True); 

To_The_String.The_ltems ( (The_String.The_Length + 1) .. 

New_Length) ^ 

•= To The String.The^Iterns(1 .. 01d_Length); 
TolThe_itring.The_Iterns{1 .. The_S tring.The_Length) : = 
The^String.The.Items(1 .. The_String.The_Length); 
exception 

when Storage_Error => 
raise Overflow; 


end Prepend; 


procedure Prepend {The_Substring : in Substring; 

To_The^String : in out String) is 
01d_Length ; Natural 7 = To_The_S tring.The_Length; 

New_Length : Natural := , t. • .r 

To_The_String.The_Length + The_Siabstring Length; 


begin 

Set(To_The_String, 

To_The_Size => New_Length, 

Preserve„The_Value => True); 

To_The_String.The_Iterns((The_Subs tring'Length + 1) .. 
New_Length) , , , _ . 

:= To_The_S tr ing. The_l terns {1 .. Old-Length); 
To_The_String. The_Iterns (1 .. The^Substring' Length) : = 

The^Substring; 
exception 

when Storage„Error => 
raise Overflow; 
end Prepend; 


procedure Append CThe_String : in String; 

TO-.The_String : in out String) is 
Old^Length : Natural”:= To_The_S tring.The_Length; 

New_Length : Natural := . t 

To_The_String-The_Length + The_String.The_Length; 


begin 

Set(To_The_String, 

To_The_Size => New_Length, 

Preserve_The_Value => True); 

To_The_S tr ing .The_I terns ((01d_Length +1) .. New_Length) 


;= The_String.The_Items(l .. The_String.The_Length); 
exception 

when storage_Error => 
raise Overflow; 
end Append; 

procedure Append (The-.Substring : in Substring; 

To_The_String : in out String) is 
Old-Length : Natural := To_The_String.The^Length; 

New^Length : Natural ;= , . 

To_The_String.The_Length + The_Substring Length; 

begin 

Se t{To_The_String, 

To_The__Size -> New_Length, 

Preserve_The_Value => True); 

To_The_String.The_Items({Old-Length +1) .. New_Length) 

;= The_Substring; 
exception 

when Storage_Error => 
raise Overflow; 
end impend; 


procedure Insert (The_String : in String; 

In_The„String : in out String; 

At_The_Position : in Positive) is 

Old-Length : Natural := In_The_String.The_Length; 

New_Length : Natural ;= 

In„The_S tring. The_Leng t h + 


The_S tring. The_Length ; 

EncLPosition : Natural := . _ 

At_The_Position + The_String.The_Length; 


^^^if At_The„Position > In_The_String.The_Length then 
raise Position_Error; 


else 

Set(In_The_String, 

To^The^Size => New_Length, 

Preserve_The-yalue => True); 

In^The_S tring. The_I terns (EncLPos ition .. New_Length) ; = 
In_The_String.The_Items(At_The_Position .. 01d_Length); 
In_The_String.The-Items(At_The-.Position .. (End-Position - 

The_String.The_Iterns(1 .. The_String,The^Length); 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Insert; 


procedure Insert {The_Substring : in Substring; 

In_The_String : in out String; 

At_The_Position : in Positive) is 

01<d_Length : Natural := In_The_String .The^Length; 

New_Length : Natural ;= 

In_The_String.The_Length + 


The_S\ibs tring' Length; 

End-Position : Natural ; = 

At_The_Position 


The_Substring'Length; 


begin 

if 


At_The_Position > In-.The-.String.The_Length then 
raise Position_Error; 


else 

Set {ln-.The_Str ing, 

To_The_Size => New_Length, 

Preserve_The_Value => True); 

In_The-.String.The_Iterns {End-Position .. New_Length) 

In_'Ihe_S tring. The_I terns {At_The_Pos it ion .. Old_Length) ; 
In_The_String. The_Iterns {At_The_Position .. (End-Position 

The_Subs tring; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Insert; 


procedure Delete {In_The_String : m out 

Fron\_The_Position : in 

To_The_Position : in 

New_Length : Natural; 

^ if {Froin_The_Position > In_The_String.The_Length) or else 
(To_The_Position > In_The_String.The_Length) or else 
{From-The_Position > To_The_Position) then 
raise Position_Error; 

else 

New_Length := In_The_String.The_Length - 

{To_The-.Position - Froii\_The_Position + 1); 
In_The_String.The_Iteins{From_The_Position .. New_Length) 

In_The_S tring. The_I terns 

({To_The_Position + 1) .. In_The_String.The_Length) ; 

Set{In_The_String, 

To_The_Size => New_Length, 

Preserve_jrhe_Value => True) ; 

end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Delete; 


String; 
Positive; 
Positive) is 


procedure Replace (In^The^String 

At_The_Position 
With_The_String 
End-Position ; Natural := 

At_The_Po sition 

1 ; 

begin 


in out String; 
in Positive; 

in String) is 

With_The_String.The_Length - 
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(The_String) ; 


if (At_The_Position > In_The_String.The_Length) or else 
{EndLPosition > In_The_String.The_Length) then 
raise Position^Error; 

else 

In_The_String.The_Items(At_The_Position .. EndLPosition) 

WitluThe_String. The_Items {1 .. 

Wi th_The_String.The_Length); 
end if; 
end Replace; 


procedure Replace (Iix_The_String : in out String; 

At_The_Position ; in Positive; 

Witlu.The_Substring : in Substring) is 

EndLPosition ; Natural := 

At_The„Position + With_The_Substring’Length - 


1 ; 

begin 

if (At_The_Position > In_The_String.The_Length) or else 
{End_Position > In_The_String.The_Length) then 
raise Position_Error; 

else 

In_The_String.The_Iteins(At_The_Position .. EndLPosition) 


WithLThe_Subs tring; 
end if; 
end Replace; 


procedure SetLltem (InLThe_String : in out String; 

At_TheLPosition ; in Positive; 

With_The_Item : in Item) is 

begin 

if At^TheLPosition > In_TheLString.The_Length then 
raise Position_Error; 

else 

ln_TheLString.TheLltems(AtLThe_Position) ;= WithLThe_Item; 
end if; 
end Set_Item; 


modified by Vincent Hong and Tuan Nguyen 
date: 9 ;^ril 1995 

adding procedures to replace functions 

procedure Is^Equal (Left 

Right 
Result 

begin 

result := Is^Equal (Left,Right); 

end ISLEqual; 


in String; 
in String; 
out Boolean) is 


begin 

result Length^Of 
end LengthLOf; 

procedure Is^Null 

begin 

result := Is_Null 
end Is_lTull; 

procedure Item_Of 


begin 

result := ItenuOf 
end ItenuOf; 

procedure SubstringjDf 

begin 

result := Substring_Of (TheLString); 
end Substring_Of; 

procedure Substring_Of (The_String : in String; 

FronuTheLPosition : in Positive; 
ToLThe_Position ; in Positive; 
Result : out Substring) is 

begin 

result 

SubstringLOf (The_String,FronuTheLPosition, TOLThe_Position) ; 
end Substring_.Of; 

— end of modification 


(TheLString ; in String; 

Result : out Boolean) is 

(TheLString); 


(TheLString : in String; 

At_The_Position : in Positive; 

Result : out Item) is 

(TheLString,At_TheLPosition); 


(The_String : in String; 

Result : out Substring) is 


function Is_Equal (Left ; in String; 

Right : in String) return Boolean is 

begin 

if Left .The_Length /=s Right.The_Length then 
return False; 

else 

for Index in 1 ., Left.The_Length loop 

if Left.The_I terns (Index) /= Right .The_l terns (Index) 


then 


return False; 
end if; 
end loop; 
return True; 
end if; 
end ISLEqual; 


procedure Is_Equal (Left 

Right 
Result 

begin 

result := Is_Bqual (Left,Right); 

end Is_Equal; 


procedure ISLEgual (Left 

Right 
Result 

begin 

result := Is^Equal (Left,Right); 

end Is^Equal; 


procedure ISLLess_Than (Left 
Right 
Result 

begin 

result := Is_LessLThan (Left,Right); 
end Is_LessLThan; 


procedure Is_LessLThan (Left 
Right 
Result 

begin 

result := ls_Less_Than (Left,Right); 
end Is_Less_Than; 


procedure laLLess^Than (Left 
Right 
Result 

begin 

result := ISLLess_Than (Left,Right); 
end ISLLess_Than; 

procedure Is_Greater_Than (Left 
Right 
Result 

begin 

result := ISLGreater_Than (Left,Right); 
end Is_Greater_Than; 


procedure ls_,Greater_Than (Left 
Right 
Result 

begin 

result := ls_GreaterLThan (Left,Right); 
end Is_Greater_Than; 


procedure Is_Greater_Than (Left 
Right 
Result 

begin 

result := Is^GreaterLThan (Left,Right); 
end Is_GreaterLThan; 

procedure Length^Of (The_String 

Result 


: in Substring; 

: in String; 

; out Boolean) is 


: in String; 

: in Substring; 

: out Booleem) is 


: in String; 

: in String; 

: out Boolean) is 


: in Stabs tr ing; 

: in String; 

: out Boolean) is 


: in String; 

; in Stabstring; 

: out Boolean) is 


: in String; 

: in String; 

: out Booleaui) is 


: in Substring; 

; in String; 

: out Boolean) is 


; in String; 

: in Substring; 

; out Boolean) is 


: in String; 

: out Natural) is 


function Is_Equal (Left ; in Substring; 

Right : in String) return Boolean is 

begin 

if Left‘Length f- Right-The_Length then 
retuam False; 

else 

for Index in 1 .. Left'Length loop 

if Left(Left'First + Index - 1) /= 

Right.The_lterns(Index) then 

return False; 
end if; 
end loop; 
retuam Tanae; 
end if; 
end Is_Equal; 


function Is_Equal (Left : in String; 

Right : in Substring) return Boolean is 

begin 

if Left.TheLLength /= Right'Length then 
retuam False; 


else 

for Index in 1 .. Left.The_Length loop 

if Left.The^Iterns(Index) /= Right(Right'First + 

- 1) then 

return False; 
end if; 
end loop; 
retuam True; 
end if; 
end Is_Equal; 


Index 


function ls_Less_Than (Left : in String; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right.The_Length then 
retuam False; 

els if Left .The_Items( Index) < High t.The_I terns (Index) then 
retuam Tanae; 

elsif Right .The^Items (Index) < Left .The_Iterns (Index) then 
retuam False; 
end if; 

end loop; 

retuam (Left.The_Length < Right.The_Length); 
end Is_L€SS_Than; 


function Is_Less_Than (Left : in Substring; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left‘Length loop 
if Index > Right.The_Length then 
retuam False; 

elsif Left(Left'First + Index - 1) < 

Right.The_Iterns(Index) then 
retuam True; 

elsif Right. The_.I terns (Index) < Left (Left'First + Index - 

1) then 
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return False; 
end if; 
end loop; 

return (Left'Length < Right.The_Length); 
end Is_Less_Than; 


function Is_Less_Than (Left : in Stringi- 

Right : in Substring) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right'Length then 
return False; 

elsif Left.The_Iterns(Index) < Right(Right‘First + Index - 

1) then 

return True; 

elsif Right(Right■First + Index - 1) < 

Left.The^Items(Index) then 

return False; 
end if; 
end loop; 

return (Left.The_Length < Right'Length) ; 
end Is_Less_Than; 

function Is_Greater_Than (Left : in String; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right.The_Length then 
return True; 

elsif Left .The_Iteins (Index) < Right*The_Iterns (Index) then 
return False; 

elsif Right.The_I terns (Index) < Left .The_I terns (Index) then 
return True; 
end if; 
end loop; 
return False; 
end Is_Greater_Than; 


function l 5 _Greater_Than (Left : in Substring; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left'Length loop 
if Index > Right.The^Length then 
return True; 

elsif Left(Left'First + Index - 1) < 

Right. The_I tems (Index) then 

return False; 

elsif Right.The_Items(Index) < Left(Left'First + Index - 

1) then 

return True; 
end if; 
end loop; 
return False; 
end Is_Greater_Than; 


function Is_Greater_Than (Left : in String; 

Right : in Substring) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right'Length then 
return True; 

elsif Left.The^ltems(Index) < Right(Right'First + Index - 

1) then 

return False; 


elsif Right(Right'First + Index - 1) < 

Left.The_Items(Index) then 

return True; 
end if; 
end loop; 
return False; 
end Is_Greater„Than; 

function Length_Of (The^String : in String) return Natural is 
begin 

return The_String,The_Length; 
end Length_Of; 

f\mction Is^ull (The_String : in String) return Boolean is 
begin 

return (The_String.The_Length = 0); 
end Is_Null; 

function ItenuOf (The_String : in String; 

At_The_Position : in Positive) return Item is 

begin 

if At_The_Position > The_String.The_Length then 
raise PositiorL-Error; 

else 

return The_String. The_Items (At_The_Position) ; 
end if; 
end Item^Of; 

function Substring_Of (The_String ; in String) return Substring is 
Teirporary_Structure : Siabstringd 1) ; 

begin 

return The_String.The_Items(1 .. The_String.The_Length); 
exception 

when Constraint_Error => 

return Tenporary^Struetured .. 0); 
end Stjbstring_Of ; 

function Substring_Of (The_String : in String; 

From_The_Position : in Positive; 

To_The_Position ; in Positive) retxim 

Substring is 
begin 

if (FroitL.The_Position > The_String.The_Length) or else 
(To_The_Position > The_String.The_Length) or else 
(FroirL.The_Position > To_The_Position) then 
raise Position^Error; 

else 

return The_String. The^ltems (From_The_Position .. 
To_The_Position); 
end if; 

end Substring_Of; 

procedure Iterate (Over_The_String : in String) is 
Continue ; Boolean; 
begin 

for The_Iterator in 1 .. Over_The_String.The_Length loop 
Process (Over_The_String. The_Items (The_Iterator), 

Continue); 

exit when not Continue; 
end loop; 
end Iterate; 

end String_Sequential_UnboundecLControlled_Iterator; 
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STRING SEQUENTIAL UNBOUNDED CONTROLLED ITERATOR 

PSDL 


TYPE String_Sequential_Unbounded^Controlled_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, 

Substring ; ARRAYlARRAY^ELEMENT : Item, ARRAY_INDEX : Positive], 
func_"<“ : FXJNCTION[Left : Item, Right ; Item, RETURN : Boolean] 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_String : String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Substring : Substring, 

To_The_String : String 
OUTPUT 

To„The_String : String 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

Tbe_String : String 
OUTPUT 

The_String : String 
EXCEPTIONS 

Overflow, PositionuError 

END 

OPERATOR Prepend 
SPECIFICATION 
INPUT 

The_String ; String, 

To_The_String : String 
OUTPUT 

To__The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Prepend 
SPECIFICATION 
INPUT 

The_S\ibstring : Substring, 

To_The_String : String 
OUTPUT 

To__The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Append 
SPECIFICATION 
INPUT 

The_String : String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Append 
SPECIFICATION 
INPUT 

The_Substring : Sxibstring, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_String : String, 

In>,The_S t r ing : S tr ing, 

At_The_Position : Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Insert 
SPECIFICATION 
INPUT 

The_Substring : Substring, 
In^The_String : String, 


At_The_Position : Positive 
OUTPUT 

In_I^e_String : String 
EXCEPTIONS 

Overflow, Position^Error 


OPERATOR Delete 

SPECIFICATION 

INPUT 

In«.The_String : String, 

Froii\_The_Position ; Positive, 

To_The_Position ; Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Replace 

SPECIFICATION 

INPUT 

In_The_String : String, 

At_The_Position : Positive, 

With_The_String : String 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Replace 
SPECIFICATION 
INPUT 

In_The_String : String, 
At_The_Position : Positive, 
With_The_S\ibstring : Svibstring 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position^Error 

END 


OPERATOR Set_Item 
SPECIFICATION 
INPUT 

In_The_String : String, 
At_The_Position : Positive, 
With_The_Item ; Item 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR IS^Equal 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result ; Boolecin 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is^Equal 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR IS_Egual 

SPECIFICATION 

INPUT 

Left : String, 

Right : Substring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Is_Less_Than 
SPECIFICATION 
INPUT 

Left ; String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 
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OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : Svibstring 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result : Booleaui 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : Substring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result : Natural 


EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Null 

SPECIFICATION 

INPUT 

The_String ; String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR ItenuOf 

SPECIFICATION 

INPUT 

The_String : String, 

At_The_Position : Positive 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Substring_Of 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result : Sxibstring 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Substring_Of 

SPECIFICATION 

INPUT 

The_String : String, 

FrortuThe_Position : Positive, 

Tojrhe_Position : Positive 
OUTPUT 

Result : Substring 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process ; PROCEDURE[The_Itern : init : Item], Continue : out[t 
Boolean]1 
INPUT 

Over_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

END 

IMPLEMENTATION ADA String_Sequential_Unbounded_ControllecLIterator 

END 
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STRING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

type Siibstring is array (Positive range <>) of Item; 
with function "<" (Left : in Item; 

Right : in Item) return Boolean; 
package String_Sequential_Unbounde{iJlanaged_Iterator is 


type String is limited private; 


procedure Copy 

procedure Copy 

procedure Clear 
procedure Prepend 

procedure Prepend 

procedure Append 

procedure Append 

procedure Insert 

procedure Insert 

procedure Delete 

procedure Replace 

proced\ire Replace 

procedure Set_ltem 


{FronL.The_S tring 
To_The_String 
{Froirt_The_Subs tring 
To_The_S t r ing 
(The_String 
{The_String 
To_The_String 
(The_Subs tring 
To_The_String 
(The_String 
To_The_String 
(11ie_Subs tring 
To_'nie_String 
(The_String 
In_The_String 
At_The_Position 
(The^Substring 
In_The_String 
At_The_Position 
(In_'nie_String 
From_The_Position 
To_'rhe_Pos ition 
(In_'nie_String 
At_Tlie_Pos ition 
With^The_String 
(In_The_String 
At_The_Position 
With_The_Subs tring 
(ln_The_String 
At_The_Position 
With_The_Item 


in 

String; 

in out 

String); 

in 

Substring; 

in out 

String); 

in out 

String); 

in 

String; 

in out 

String); 

in 

Substring; 

in out 

String); 

in 

String; 

in out 

String); 

in 

Substring; 

in out 

String); 

in 

String; 

in out 

String; 

in 

Positive); 

in 

Substring; 

in out 

String; 

in 

Positive); 

in out 

String; 

in 

Positive; 

in 

Positive); 

in out 

String; 

in 

Positive; 

in 

String); 

in out 

String; 

in 

Positive; 

in 

Substring) 

in out 

Stringi- 

in 

Positive; 

in 

Item); 


modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace f\inctions 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Is«.Egual 

(Left 

in String; 

Right 

in Stringi- 


Result 

out Booleein) ; 

Is^Equal 

(Left 

in Substring; 

Right 

in String; 


Result 

out Booleein) ; 

Is_Equal 

(Left 

in String; 

Right 

in Substring; 


Result 

out Boolean); 

Is_Less_Than 

(Left 

in String; 


Right 

in String; 


Result 

out Boolean); 

Is_Less_Than 

(Left 

in Substring; 


Right 

in String; 


Result 

out Boolean); 

Is_Less_Than 

(Left 

in String; 


Right 

in Substring; 


Result 

out Boolean); 

Is_Greater_Than 

(Left 

in String; 


Right 

in String; 


Result 

out Boolean); 

ls_Grea terjThan 

(Left 

in Substring; 


Right 

in String; 


Result 

out Boolean); 

Is_Greater_Than 

(Left 

in String; 


Right 

in Substring; 


Result 

out Boolean); 


procedure Length_Of 

(The_String 

: in String; 


Result 

: out Natural); 

procedure IsJKull 

(The_String 

: in String; 

Result 

: out Boolean); 

procedure ItenuOf 

(The^String 

; in String; 


At_The_Position 

: in Positive; 


Result 

: out Item) ; 

procedure Sxibstring_Of 

(The_String 

; in String; 

Result 

; out Substring); 

procedure SubstringjOf 

(The_String 

: in String; 

FroitL.The_Pos ition 

: in Positive; 


To_The_Po sition 

; in Positive; 

— end of modification 

Result 

; out Slabstring) ; 

function Is_Equal 

(Left : 

in String; 

Boolean; 

Right ; 

in String) return 

function Is_Equal 

(Left : 

in Slabstring; 

Boolean; 

Right ; 

in String) return 

function Is_Equal 

(Left : 

in String; 

Boolean; 

Right : 

in Substring) return 

function Is_Less_Than 

(Left : 

in String; 

Boolean; 

Right : 

in String) return 

function Is_Less_Than 

(Left : 

in Substring; 

Boolean; 

Right : 

in String) return 

function Is„Less_Than 

(Left : 

in String; 

Boolean; 

Right : 

in Substring) return 

function Is_Greater_Than 

(Left : 

in String; 

Boolean; 

Right : 

in String) return 

function Is_Greaterjrhan 

(Left : 

in Substring; 

Boolean; 

Right : 

in String) return 

function Is_Greater_Than 

(Left : 

in String; 

Boolean; 

Right : 

in Substring) return 

function Length^Of 
Natural; 

(The_String ; 

in String) return 

function Is^Null 

Boolean; 

(The_String ; 

in String) return 

function Item_Of 

{The_String ; 

in String; 

Item; 

At_The_Position ; 

in Positive) return 

function Substring_Of 
Substring; 

(The_String ; 

in String) return 

function Substring_Of 

(The^String ; 

in String; 


FronuThe_Position : 

in Positive; 

Substring; 

generic 

To_The_Position ; 

in Positive)return 

with procedure Process {The_Item : rn Item; 


Continue : out Boolean); 

procedure Iterate (Over_The_String ; in String); 


Overflow : exception; 

Position_Error : exception; 


private 

type Structure is access Substring; 
type String is 
record 

The_Jiength : Natural := 0; 

The_lterns : Structure; 
end record; 

end String_Sequential_UnboundedJManaged_lterator; 
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STRING SEQUENTIAL UNBOUNDED MANAGED ITERATOR 

PSDL 


TYPE String_Sequential_Unboiande<LManagecLIterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, . . , 

Substring : ARRAY[ARRAy_ELEMENT : Item, ARRAY_INDEX : Positive], 
: FUNCTIONlLeft : Item, Right : Item, RETURN : Boolean] 
OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_String : String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Copy 
SPECIFICATION 
INPUT 

Fron\_The_Substring : Substring, 
To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The^String ; String 
OUTPUT 

The_String ; String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Prepend 
SPECIFICATION 
INPUT 

The_String : String, 
To_The_String ; String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Prepend 
SPECIFICATION 
INPUT 

The_Siibstring ; Substring, 
To_The_String ; String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Append 
SPECIFICATION 
INPUT 

The_String : String, 
To_The_String : String 
OUTPUT 

To_The_String ; String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR ;^pend 
SPECIFICATION 
INPUT 

The_Substring : Substring, 
To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_String : String, 
In_The_String : String, 
At_The_Position : Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The^Substring : Substring, 
In_The_String : String, 


At_The_Position : Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 


OPERATOR Delete 

SPECIFICATION 

INPUT 

In_The_String : String, 

From_The„Position : Positive, 

To_The_Position : Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Replace 

SPECIFICATION 

INPUT 

In^The_String : String, 

At_The_Position : Positive, 

With_The_String : String 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Replace 

SPECIFICATION 

INPUT 

In_The_String : String, 

At_The_Position : Positive, 

With_The_Substring : Substring 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Set^Item 

SPECIFICATION 

INPUT 

In_The_String : String, 

At_The_Position : Positive, 

With_The_Item ; Item 
OUTPUT 

In^The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Equal 

SPECIFICATION 

INPOT 

Left : String, 

Right : String 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR IS_Equal 

SPECIFICATION 

INPUT 

Left : Substring, 

Right ; String 
OOTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : String, 

Right ; Substring 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Position^Error 

END 


OPERATOR Is_Less_Than 
SPECIFICATION 
INPUT 

Left ; String, 

Right : String 
OOTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position__Error 

END 
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OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left : S\ibstring, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is„Less_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : Substring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : Substring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Length^Of 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result : Natural 


EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR IS_Null 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result : Booleein 
EXCEPTIONS 

Overflow, Position__Error 

END 

OPERATOR IteituOf 

SPECIFICATION 

INPUT 

The_String : String, 

At_The_Position : Positive 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Substring^Of 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result ; Substring 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Siibstring_Of 

SPECIFICATION 

INPUT 

The_String : String, 

FronL_The_Position : Positive, 

To_The_Position : Positive 
OUTPUT 

Result : Substring 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE IThe_Itern : in(t ; Item], Continue : out[t : 
Boolean]] 

INPUT 

Over_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

END 

IMPLEMENTATION ADA String_Sequential_UnboundedJIaiiagecLIterator 
END 
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STRING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA SPECIFICATIONS 


generic 

type Item is private; 

type S\ibstring is array (Positive range <>) of I tern; 
with fxmction •<" (Left : in Item; 

Right : in Item) return Boolean; 

package string_Se< 3 uential_Unboundedi_Uninanaged_Noniterator is 


type String is limited private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

(FronuThe_String 

in 


String; 


To_The_String 

in 

out 

String); 

Copy 

(From_The_Substring 

in 


Svibs bring ; 


To_The_S bring 

in 

out 

String); 

Clear 

(The„String 

in 

out 

String); 

Prepend 

(The_String 

in 


String; 


To_The_S bring 

in 

out 

String); 

Prepend 

{The_Subs bring 

in 


Substring; 


To_The_S tr ing 

in 

out 

String); 

Append 

(The_String 

in 


String; 


To_The_S bring 

in 

out 

String); 

Append 

(The^Subsbring 

in 


Substring; 


To_The_Sbring 

in 

out 

String); 

Insert 

(The_String 

in 


String; 


In_The_S bring 

in 

out 

String; 


At_The_Position 

in 


Positive); 

Insert 

(The_Subsbring 

in 


Substring; 


In_The_String 

in 

out 

String; 


At_The_Position 

in 


Positive); 

Delete 

(In_The_String 

in 

out 

String; 


From_The_Position 

in 


Positive; 


To_The_Position 

in 


Positive); 

Replace 

(In_The_Sbring 

in 

out 

String; 


At_The_Position 

in 


Positive; 


With_The_String 

in 


String); 

Replace 

(In_The_String 

in 

out 

String; 


At_The_Position 

in 


Positive; 


With_The_Subsbring 

in 


Substring) 

Set^Item 

(In_The_Sbring 

in 

out 

Stringi- 


At_The_Position 

in 


Positive; 


With_The_Item 

in 


Item) ; 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

— adding procedures to replace functions 


procedure Is_Equal (Left 

Right 
Result 

procedure Is^Equal (Left 

Right 
Result 

procedure Is^Equal (Left 

Right 
Result 

procedure Is_Less_Than (Left 

Right 
Result 

procedure ls_Less_Than (Left 

Right 
Result 

procedure Is_Less_Thcin (Left 

Right 
Result 


procedure Is_Greater_Than (Left 
Right 
Result 

procedure Is_Greater_Than (Left 
Right 
Result 

procedure Is_Greater_Than (Left 


in String; 
in String; 
out Boolean); 
in Substring; 
in String; 
out Boolean); 
in String; 
in Substring; 
out Boolean); 
in String; 
in String; 
out Boolean); 
in Substring; 
in String; 
out Boolean); 
in String; 
in Substring; 
out Boolean); 
in String; 
in String; 
out Boolean); 
in S\ibstring; 
in String; 
out Boolean); 
in String; 


procedure Length_Of 
procedure Is^Null 
procedure Item_Of 


procedure Substring_Of 
procedure Substring__Of 


Right 
Result 
(The_String 
Result 
(The_String 
Result 
(The_Sbring 
At_The_Position 
Result 
(The_String 
Result 
{The_Sbring 
Fr oro_The__Pos i tion 
To_The_Position 
Result 


in Substring; 
out Boolean); 
in String; 
out Natural); 
in String; 
out Boolean); 
in String; 
in Positive; 
out Item) ; 
in String; 
out Substring); 
in String; 
in Positive; 
in Positive; 
out Substring); 


end of modification 


function 

Boolean; 

function 

Boolean; 

function 

Boolean; 

fxinction 

Boolean; 

function 

Boolean; 

function 

Boolean; 

function 

Boolean; 

function 

Boolean; 

fiinction 

Boolean; 

fimction 

Natural; 

function 

Boolean; 

function 

I tern; 

function 

Substring; 

function 


Is_Equal 

(Left 

: in 

String; 


Right 

: in 

String) 

return 

Is_Equal 

(Left 

: in 

S\ibstring; 


Right 

: in 

String) 

return 

Is_Equal 

(Left 

: in 

String; 


Right 

: in 

Substring) 

return 

Is_Less_Than 

(Left 

: in 

String; 



Right 

: in 

String) 

return 

Is_Less_Than 

(Left 

; in 

Substring; 


Right 

: in 

String) 

return 

ls_Less_Than 

(Left 

: in 

String; 



Right 

: in 

Substring) 

return 

Is_Greater_Than 

(Left 

: in 

String; 



Right 

: in 

String) 

return 

Is_Greater_Than 

(Left 

: in 

Substring; 



Right 

: in 

String) 

return 

Is_Greater_Than 

(Left 

: in 

String; 



Right 

: in 

Substring) 

return 

Length_0f 

(The_String 

: in 

String) 

return 

IsJNull 

(The_Sbring 

: in 

String) 

return 

ItenuOf 

(The_Sbring 

: in 

Stringy- 

return 

At_The_Position 

; in 

Positive) 

Substring_Of 

(The_Sbring 

: in 

String) return 

Substring_Of 

(The_Sbring 
FroitL_The_Position : 

: in 
: in 

Stringy- 
Positive ; 



To_The_Position 

: in 

Positive)return 


Substring; 


Overflow : exception; 

Position_Error : exception; 


private 

type Structure is access Siibstring; 
type String is 
record 

The_Length : Natural := 0; 

The_Items : Structure; 
end record; 

end string_Sequential_Unbounded_Uninanaged_Noniterator; 
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STRING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 

ADA IMPLEMENTATION 


— {C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Ntmber 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in sijbdivision (b) (3) {ii) 

— of the rights in Technical Data and Computer 

— Software Clause of PAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body String_Sequential_UnboundecLUninanagecLNoniterator is 

procedure Set (The_String : in out String; 

To_The_Size : in Natural; 

Preserve__The_Value ; in Boolean) is 

Tenporary_Structure : Structure; 
begin 

if To„The_Size = 0 then 

The_String. The_I terns : = nu 11 ; 
elsif The_String.The_Iterns = null then 

The_String.The_Iterns := new Substring(1 To_The_Size) ; 

elsif To_The_Size > The_String.The_Iterns’Length then 
if Preserve_The_Value then 

Tenporary_Structure new Substring(1 .. 

To_The_Size); 

Teinporary_Structure(1 .. The_String.The_Length) 

The_S tring.The„Iterns(1 .. The_String.The_Length); 
The_String.The_Iterns := Temporary_Structure; 

else 

The_String.The_Iterns := new Slabstring(1 .. 

To_The_Size); 

end if; 
end if; 

The_String.The_Length := To_The_Size; 
end Set; 

procedure Copy (From_The_String : in String; 

To_The_String : in out String) is 

begin 

Set(To_The_String, 

To_The_Size => From_The_String.The_Length, 

Preserve_The_Value => False); 

To_The_Str ing. The_I terns (1 .. FronuThe_String. The_Length) : = 
FronL.The_String.The_Iterns (1 ,. FromL_The_String.The^Length) ; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Copy (Fron\„The_Substring : in Substring; 

To_The_String : in out String) is 

begin 

Se t{To_The_String, 

To_The_Size => From_The_Substring’Length, 

Preserve_The_Value => False); 

To_The_String.The_Items{l .. Frorn_The_Substring'Length) : = 
Frora_The_Substring; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear {The_String : 
begin 

Set(The_String, 

To_The_Size => 

Preserve_The_Value => 
end Clear; 

procedure Prepend (The^String ; in String; 

To_The_String : in out String) is 
OldLLength : Natural ;= To_The_String.The_Length; 

New_Length : Natural ;= 

To_The_String.The_Length + The_String.The_Length; 

begin 

Se t(To_The_String, 

To_The_Size => New_Length, 

Preserve_The_Value => True); 

To_The_String,The_Items( (The_String.The_Length -f 1) .. 

New_L€ngth) 

:= To_The_S tr ing. The_I terns (1 .. Old^Length); 
To_The_String.The_Items(l The_String.The_Length) := 
The_String.The_Items(l .. The_String.The_Length); 
exception 

when Storage_Error => 
raise Overflow; 
end Prepend; 

procedure Prepend (The_Substring : in Substring; 

To_The_String : in out String) is 
Old_Length : Natural ;= To_The_String.The_Length; 

New_Length : Natural := 

To_The_String.The_Length + The_Substring■Length; 

begin 

Se t(To_The_String, 


To_The_Size =j> New_Length, 

Preserve_The_Value => True); 

To_The_String.The_Iteins( (The_Substring'Length + 1) .. 
New_Length) 

:= To_The_String.The_Iterns(1 .. 01d_Length); 
To_The_String.The_Items(l .. The_Substring'Length) := 

The_Subs tring; 
exception 

when Storage_Error => 
raise Overflow; 
end Prepend; 

procedure Append (The_String : in String; 

To_The_String : in out String) is 
OlcLLength ; Natural To_The_String.The_Length; 

New_Length : Natural := 

To_The_String.The_Length + The_String.The_Length; 

begin 

Set(To_The_String, 

To_The_Size => New_Length, 

Preserve_The_Value => True); 

To_The_String.’rhe_Iteins ((OlcLLength +1) .. New_Length) 

; = ’rhe_String. The_I terns (1 .. The_S tr ing. TheJLength) ; 
exception 

when Storage_Error => 
raise Overflow; 
end Append; 

procedure Append (The_Substring : in Substring; 

To_The_String : in out String) is 
01d_Length : Natural To_The_String.The_Length; 

NewJLength : Natural := 

To_The_S tr ing. The_Lengt h + The_Subs t r ing ‘ Length; 

begin 

Set(To_The_String, 

To_The_Size -> New_Length, 

Preserve_The_Value -> True); 

To_The_String.The_Items({01d_Length +1) .. New_Length) 

The_Substring; 

exception 

when Storage_Error => 
raise Overflow; 
end Append; 

procedure Insert (The_String : in String; 

In_The_String : in out String; 

At_The_Position : in Positive) is 
Old^Length : Natural := In_The_String.The_Length; 

New_Length : Natural := 

In_The_S tr ing. The_Leng th + 

The_String.The_Length; 

EndLPosition : Natural :® 

At_The_Position + The_String.The_Length; 

begin 

if At_The_Position > InLrhe_String.The_Length then 
raise Position^Error; 

else 

Set(In_The_String, 

To_The_Size => New_Length, 

Preseirve_The_Value => True); 

In_The_String.The_Items (End-Position .. New_Length) :* 
In-,The_String.The_Itenis(At_The_Position .. OlcLJiength); 
In The_String.The_Iterns (At_The_Position .. (EndLPosition - 

D) : = 

The_S tr ing. The_I terns (1 .. Th€_S tring. The_Leng th) ; 
end if; 
exception 

when Storage^Error 
raise Overflow; 
end Insert; 

procedure Insert (The_Substring ; in Substring; 

In_The_String : in out String; 

At_The_Position : in Positive) is 
01d_Length : Natural := In_The_String.The_Length; 

New_Length : Natural 

In_The_S tr ing. The_Leng t h + 

The_Substring'Length; 

End_Position ; Natural := 

At_The_Position + The^Substring’Length; 

begin 

if At_The_Position > In_The_String-TheJLength then 
raise PositioruError; 

else 

Set(In_ThejString, 

TOjThCjSize -> NewJLength, 

PreservejThe_Value => True); 

InjThe_S tr ing. The_I terns (EndLPosition .. New_Length) : = 
InjThe_String.The_Iterns(At_The_Position .. OldLLength); 
In_Th€_String.ThCjIterns(At_The_.Position .. (End_Position - 

D) : = 

The_.Substring; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Insert; 

procedure Delete (In_ThejString : in out String; 


in out String) is 
0 , 

False); 
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FronL.The_Position : in Positive; 

To_The_Position : in Positive} is 

New^Iicngth : Natural; 
begin 

if (FronuThe_Position > In_The_String.The_Length) or else 
(To_The_Position > Injrhe_String,The_Length} or else 
{FronL.The_Position > To_The_Position) then 
raise Position^Error; 

else 

New Length := In^The_String.The_Length - 

~ (To_The_Position - FronL,The_Position +1); 

In_The_String.The_Iterns(FrortuThe_Position .. New_Length) 

In_The_Str ing. The_I terns 

{(To_The_Position +1) In_The_String.The_Length); 
Set(In_The_String, 

To_The_Si 2 e => New_Length, 

Preserve_The_Value => True); 

end if; 
end Delete; 


procedure Replace (In_The_String : in out String; 

At_The_Position : in Positive; 

With_The_String : in String) is 

End^Position : Natural ^ 

At_The_Position + With_The_Strxng.The_Length - 


begin 

if (At_The_Position > In_The_String.The_Length) or else 
(EncLPosition > In_The_String.The_Length) then 
raise Position_Error; 

else , . . , 

In_The_String.The_Items(At_The_Position .. End_Position} 

Wi thL_The_Str ing. The_I terns (1 .. 
With_The_String.The_Length) ; 
end if; 
end Replace; 

procedure Replace (In_The_String : in out String; 

At_The„Position ; in Positive; 

With_The_Substring : in Substring) is 

End_Position : Natural := 

At_The_Position + With_The_Substring*Length - 

1 ; 

begin 

if (At_The_Position > In_The_String.The_Length) or else 
(End_Position > In_The_String.The_Length} then 
raise Position__Error; 

else , . . , 

In_The_String. Tlie_Iterns (At_The_Position .. End_Posxtion) 

With_The_Substring; 
end if; 
end Replace; 

procedure Set_Item {In_The_String : in out String; 

At_The„Position : in Positive; 

With_The„Item : in Item) is 

if At_The_Position > In_The_String.The_Length then 
raise Position_Error; 

else - 

In_The__String.The_Items(At_The_Positaon) := Wxth_The_Item; 
end if; 
end Set_Item; 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

adding procedures to replace functions 


procedure Is_Equal 


begin 

result := Is_Equal 
end Is_Equal; 

procedure Is_Equal 


begin 

result ;= Is_Equal 
end Is^Equal; 

procedure Is_Equal 


begin 

result := Is_Equal 
end Is_Equal; 


(Left 

Right 

Result 

(Left,Right); 


(Left 

Right 

Result 

(Left,Right); 


(Left 

Right 

Result 

(Left,Right); 


procedure Is_Less_Than 


(Left 

Right 

Result 


begin 

result := Is_Less_Than 
end Is_Less_Than; 


(Left,Right); 


procedure Is_Less_Than 


(Left 

Right 

Result 


begin 

result := Is_Less_Than 
end Is_Less_Than; 


(Left,Right); 


procedure Is_Less_Than (Left 
Right 


in String; 
in String; 
out Boolean) is 


in Substring; 
in String; 
out Boolean) is 


in String; 
in Substring; 
out Boolecin) is 


in String; 
in String; 
out Boolean) is 


in Substring; 
in String; 
out Boolean) is 


in String; 
in Substring; 


Result 

begin 

result := Is_Less_Than (Left,Right); 

end Is_Less_Than; 

procedure Is__Greater_Than (Left 
Right 
Result 

begin 

result := Is_Greater_Than (Left,Right); 
end Is_Greater_Than; 

procedure Is_Greater_Than (Left 
Right 
Result 

begin 

result := ls_Greater_Than (Left,Right); 
end Is_Greater„Than; 


: out Boolean) is 


: in String; 

: in String; 

: out Boolean) is 


; in Substring; 

: in String; 

: out Boolean) is 


procedure Is_Greater_„Than 


(Left 

Right 

Result 


begin 

result :=: Is_Greater_Than (Left,Right); 


Tc? TVian •• 


procedure Length_Of 
begin 

result := Length_Of 
end LengtlL_Of; 

procedure Is_Null 

begin 

result := Is_Null 
end Isjaull; 

procedure ItenuOf 


(The_String 

Result 

(The_String); 


(The_String 

Result 

{The_String); 


(The_String 

At_The_Position 

Result 


in String; 
in Substring; 
out Boolean) is 


in String; 
out Natural) is 


in String; 
out Boolean) is 


in String; 
in Positive; 
out Item) is 


begin 

result := ltem_Of 
end Iteitt.Of; 


(The_String,At_The_Position); 


procedure Substring_Of (The_String 
Result 


begin 

result Substring_Of 
end Substring_Of; 


(The_String); 


in String; 

out Substring) is 


procedure S\jbstring_Of 


(The_String 
Froin_The_Po s i t ion 
To_The_Position 
Result 


: in String; 

; in Positive; 

: in Positive; 

: out Substring) 


begin 

result := . . « 

Substring_Of (The^String,From_The_Position, To_The_Position); 
end Substring_Of; 


is 


end of modification 


function Is_Equal (Left : in String; 

Right : in String) return Boolean xs 

begin 

if Left.The_Length /= Right.The_Length then 
return False; 

else 

for Index in 1 -. Left.The_Length loop 

if Left.The_Items(Index) /» Right.The_Iterns(Index) 


then 


end 


return False; 
end if; 
end loop; 
return True; 
end if; 

Is^Equal; 


function Is^Egual (Left : in Substring; 

Right : in String) return Boolean xs 

begin 

if Left'Length /= Right.The_Length then 


else 

for Index in 1 .. Left'Length loop 

if Left(Left'First + Index - 1) /= 
Right.The_Iterns(Index) then 

return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 


function Is_Equal (Left : in String; 

Right : in Substring) return Boolean xs 

begin 

if Left.The^Length /= Right'Length then 
return False; 

else 

for Index in 1 .. Left.The_Length loop 

if Left.The_Items(Index) /= Right(Right'First + Index 


“ 1) then 


return False; 
end if; 
end loop; 
return True; 
end if; 


280 





end Zs_Egual; 

function Is_Less_Than (Left ; in String; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right.The_Length then 
return False; 

elsif Left .The_Iterns (Index) < Right .The_Iterns (Index) then 
return True; 

elsif Right,The_Iterns (Index) < Left.The_Iteins (Index) then 
return False; 
end if; 
end loop; 

re turn (Left.The_Length < Right.The_Length); 
end Is_Less_Than; 

function Is_Less_Than (Left : in Substring; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left'Length loop 
if Index > Right.The_Length then 
return False; 

elsif Left(Left'First + Index - 1) < 

Right.The_Iterns(Index) then 
return True; 

elsif Right.The_Iterns(Index) < Left(Left'First + Index - 

1) then 

return False; 
end if; 
end loop; 

return (Left'Length < Right-The_Length); 
end Is_Less_Than; 


function Is_Less_Than (Left : in Stringi- 

Right : in Sxibstring) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right'Length then 
return False; 

elsif Left .The_Iterns (Index) < Right (Right'First + Index - 

1) then 

return True; 

elsif Right (Right' First Index - 1) < 

Left.The_Iterns(Index) then 

return False; 
end if; 
end loopi- 

return (Left.The_Length < Right'Length); 
end Is_Less_Than; 

function Is_Greater_Than (Left : in Stringi- 

Right : in String) return Boolean is 

begin 

for Index in 1 ,. Left.The_Length loop 
if Index > Right,The_Length then 
return True; 

elsif Left.The^Iterns (Index) < Right .The_Items (Index) then 
return False; 

elsif Right .The_Iterns (Index) < Left .The^Items (Index) then 
return True; 
end if; 
end loop; 
return False; 
end Is_Greater_Thani- 

function Is_Greater_.Than (Left : in Substring; 

Right ; in String) return Boolean is 

begin 

for Index in 1 .. Left'Length loop 
if Index > Right.The_Length then 
return True; 


elsif Left (Left‘First -v Index - 1) < 

Right.The_Iterns(Index) then 
return False; 

elsif Right. The_I terns (Index) < Left (Left'First Index - 

1) then 

return True; 
end if; 
end loop; 
return False; 
end Is_Greater_Than; 

function Is_Greater_Than (Left ; in String; 

Right ; in Substring) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right'Length then 
return True; 

elsif Left.The_Items(Index) < Right(Right'First + Index - 

1) then 

return False; 

elsif Right (Right'First Index - 1) < 

Left. The_I terns (Index) then 
return True; 
end if; 
end loop; 
retum False; 
end Is_Greater_Than; 

function Length_Of (The_String : in String) return Natural is 
begin 

return The^String.TheJLength; 
end Length_Of; 

ftinction Is_Null (The_String : in String) return Boolean is 
begin 

return (The_String.The_Length = 0); 
end Is_Null; 

function IteituOf (The_String : in String; 

At_The_Position : in Positive) return Item is 

begin 

if At_The_Position > The_String.The_Length then 
raise Position^Error; 

else 

return The_String.The_Items(At_The_Position); 
end if; 
end Iteir\_Of; 

function S\jbstring_Of (The_String ; in String) return Substring is 
Teitporary_Structure : Substring (1 .. 1) ; 
begin 

return The_String.The_Items(1 .. The_String.The_Length); 
exception 

when Constraint_Error => 

return Tenporary_Structure(l .. 0); 
end Substring^Of; 

f\mction Substring_Of (The_String : in String; 

Fronv_The_Position ; in Positive; 

To_The_Position ; in Positive) return 

Substring is 
begin 

if (From_The_Position > The_String.The_Length) or else 
(To_The_Position > The_String.The_Length) or else 
(Fronijrhe__Position > To_The_Position) then 
raise Position^Error; 

else 

return The_S tring.The_I terns (Froin_The_Pos it ion 
To_The_Position); 
end if; 

end Substring_Of; 


end String_Seguential_Unbounded«.UninanagedJJoniterator; 






STRING SEQUENTIAL UNBOUNDED UNMANAGED NONITERATOR 


PSDL 


TYPE string__Secjuential_UnboundedLUnmanaged_Noniterator 

SPECIFICATION 

GENERIC 

Item : PRIVATE_TYPE, , . 

Substring : ARRAYIARRAY.ELEMENT : Item, ARRAY_INDEX : Positive], 
func_''<*' : FUNCTION [Left : Item, Right : Item, RETURN : Boolean] 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroitL_The_String : String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Substring : Substring, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_String : String 
OUTPUT 

The_String ; String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Prepend 
SPECIFICATION 
INPUT 

The_String ; String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Prepend 
SPECIFICATION 
INPUT 

The_Substring : Substring, 

To_The_String : String 
OXJTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Append 
SPECIFICATION 
INPUT 

The_String : String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Append 
SPECIFICATION 
INPUT 

The_Substring : Substring, 

To_The_String ; String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_String ; String, 

In_The_String : String, 

At_The_Position : Positive 
OUTPUT 

In_The_String ; String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The^Siibstring : Substring, 

In_The_String : String, 


At_The_Position : Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Delete 

SPECIFICATION 

INPUT 

In_The_String : String, 

FroiruThe_Position : Positive, 

To_The_Position : Positive 
OUTPUT 

In_The_String ; String 
EXCEPTIONS 

Overflow, Positioa-Error 

END 

OPERATOR Replace 

SPECIFICATION 

INPUT 

In_The_String : String, 

At_The_Position : Positive, 

With_The_String ; String 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Replace 

SPECIFICATION 

INPUT 

In_The_String : String, 

At_The_Position : Positive, 

With_The_Substring : Substring 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Set_Item 
SPECIFICATION 
INPUT 

In_The_String : String, 
At_The_Position : Positive, 
With_The_Item : Item 
OUTPUT 

InL_The_String ; String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is„Equal 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR ls_Equal 

SPECIFICATION 

INPUT 

Left : String, 

Right : Substring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 
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OPERATOR Is_Less_Thaxi 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Positioh_Error 

END 

OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : Siibstring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, PositionL.Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : S\ibstring, 

Right : String 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : Stjbstring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Length_Of 


SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR ISjIull 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR ItenuOf 

SPECIFICATION 

INPUT 

The_String : String, 

At_The_Position ; Positive 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Substring_Of 

SPECIFICATION 

INPUT 

The_String ; String 
OUTPUT 

Result : Substring 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Substring_Of 

SPECIFICATION 

INPUT 

The_String : String, 

FroiiL.The_Position : Positive, 

To^The^Position : Positive 
OUTPUT 

Result : Substring 
EXCEPTIONS 

Overflow, Position_Error 

END 

END 

IMPLEMENTATION ADA String_Seguential_UnboundecLUninanage<2LNoniterator 
END 
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STRING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 
ADA SPECIFICATIONS 


generic 

type Item is private; 

type Sxjbstring is array (Positive range <>) of Item; 
with function "<" (Left : in Item; 

Right : in Item) return Boolean; 

package string_Sequential_UnboundecLUnmanaged_Iterator is 


type String is limited private; 


procedure Copy 

procedure Copy 

procedure Clear 
procedure Prepend 

procedure Prepend 

procedure Append 

procedure Append 

procedure Insert 

procedure Insert 

procedure Delete 

procedure Replace 

procedure Replace 

procedure Set^ltem 


(From_The_String 
To_The_String 
(From_The_Subs tring 
To_The_String 
(The_String 
{The_String 
To_The_S tring 
{The_S\ibs t r ing 
Tojrhe_S t r ing 
{The_String 
To_The_String 
(The^Subs tr ing 
To_The_S tr ing 
(The_String 
In_The_String 
At_The_Position 
{The^Stibs tr ing 
In_The_String 
At_The_Position 
{In_The_String 
FronuThe_Position 
To_The_Position 
(In_The_String 
At_The_Position 
With_The_String 
(In_The„String 
At_The_Position 
With_The_Substring 
(In_The_String 
At_The_Position 
With_The_Item 


in 


string; 

in 

out 

String); 

in 


Substring; 

in 

out 

String); 

in 

out 

String); 

in 


String; 

in 

out 

String); 

in 


Sxjbstring; 

in 

out 

String); 

in 


String; 

in 

out 

String); 

in 


Substring; 

in 

out 

String); 

in 


String; 

in 

out 

Stringi- 

in 


Positive) ; 

in 


Sxibstring; 

in 

out 

String; 

in 


Positive); 

in 

out 

String; 

in 


Positive; 

in 


Positive); 

in 

out 

String; 

in 


Positive; 

in 


String); 

in 

out 

String; 

in 


Positive; 

in 


Substring) 

in 

out 

String; 

in 


Positive; 

in 


Item); 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 199S 

— adding procedures to replace functions 


procedure Is^Equal (Left 

Right 
Result 

procedure Is^Equal (Left 

Right 
Result 

procedure Is^Equal (Left 

Right 
Result 

procedure Is_Less_Than (Left 

Right 
Result 

procedure Is^Less_Thcin (Left 

Right 
Result 

procedure lE_Less_Than (Left 

Right 
Result 


procedure Is_Greater_Than (Left 
Right 
Result 

procedure Is_Greater_Than (Left 
Right 
Result 

procedure Is_Greater_Than (Left 
Right 
Result 


in String; 
in String; 
out Boolean); 
in Substring; 
in String; 
out Boolean); 
in String; 
in Substring; 
out Boolean); 
in String; 
in String; 
out Boolean); 
in Substring; 
in String; 
out Boolean); 
in String; 
in Substring; 
out Boolean); 
in String; 
in String; 
out Boolean); 
in Substring; 
in String; 
out Boolean); 
in String; 
in Substring; 
out Boolean); 


procedure Length_0f 

(The_String 

in String; 

Result 

out Natural); 

procedure IsJIull 

(The_String 

in String; 

Result 

out Boolean); 

procedure IteituOf 

(The_String 

in String; 

At_The_Position 

in Positive; 


Result 

out Item) ; 

procedure Substring_Of 

(The_String 

in String; 

Result 

out Slabstring) ; 

procedure Siibstring_Of 

(The_String 

in String; 

Fr ortL_The_Pos i t ion 

in Positive; 


To_The_Position 

in Positive; 

— end of modification 

Result 

out Substring); 

function Is_Equal 

(Left : 

in String; 

Right : 

in String) return 

Boolean; 


in Substring; 

function Is_Equal 

(Left : 

Right 

in String) return 

Boolean; 


in String; 

fxinction Is_Egual 

(Left : 

Right : 

in Siibstring) return 

Boolean; 


in String; 

function Is_Less_Than 

(Left : 

Boolean; 

Right : 

in String) return 

function Is_Less_Than 

(Left : 

in Substring; 

Right : 

in String) return 

Boolean; 


in String; 

fxjnction Is_Less_Than 

(Left : 


Right : 

in Substring) return 

Boolean; 


in String; 

function ls_Greater_Than 

(Left : 

Right : 

in String) return 

Boolean; 


in Substring; 

function Is_Greater_Than 

(Left : 

Right : 

in String) return 

Boolean; 


in String; 

function Is„Greater_Than 

(Left : 

Boolean; 

Right : 

in Substring) return 

function Length_Of 
Natural; 

(The_String : 

in String) return 

function Is_Null 

(The_String : 

in String) return 

Boolean; 


in String; 

fianction Item_Of 

(The_String : 

At_The_Position : 

in Positive) return 

I tern; 

function Substring^Of 

{The_String : 

in String) return 

Svibstring; 


in String; 

function Substring_Of 

(The_String : 


From_The_Position : 

in Positive; 


To^The_Position ; 

in Positive)return 


Substring; 


generic 

with procedure Process (The_Item : in Item; 

Continue : out Boolean); 

procedure Iterate (Over_The_String : in String); 

Overflow : exception; 

Position_Error : exception; 

private 

type Structure is access Substring; 
type String is 
record 

'Ihe_Length : Natural ;= 0; 

The_Iteins : Structure; 
end record; 

end String_Sequential_Unbounded_Uninanaged_Iterator; 
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STRING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 
ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nxuober 0100219 

■Restricted Rights Legend* 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data eind Con^uter 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

package body String_Sequential_Unbounded_UninanagecLIterator is 

procedure Set (The_String : in out String; 

To_The_Size ; in Natural; 

Preserve_The_Value : in Boolean) is 

Ten?>orary_Structure : Structure; 
begin 

if To_The_Size = 0 then 

The_String.The_Iterns := null; 
elsif The_String.The_Items « null then 

The_String.The„Iterns := new Substring(1 .. To_The_Size) ; 
elsif To_The_Size > The_String.The_Iterns'Length then 
if Preserve_The_Value then 

Teinporary_Structure new Substring 11 .. 

To_The_Size); 

Teinporary_Structure(l .. The_String.The_Length) : = 
The_String.The_Iterns(1 .. The_String,The_Length); 
The_String.The_Iterns Teitporary_Structure; 

else 

The_String.The„Iteins := new Substring(1 .. 

To_The_Size); 

end if; 
end if; 

The_S tring.The_Length := To_The_Size; 
end Set; 

procedure Copy (Froin_The_String : in String; 

To_The_String ; in out String) is 

begin 

Set{To_The_String, 

To_The_Size => FrortL.The_String.The_Length, 

Preserve_The_Value => False); 

To_The_String.The_Iterns(1 Froin_The_String.The_Length) ; = 

FroitL_The_String.The_Iteins (1 .. FrortuThe_String.The^Length) ; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Copy (From_The_Siibstring : in Substring; 

To_The_String : in out String) is 

begin 

Se t(To_The_String, 

To_The_Size => Froin_The_Substring'Length, 

Preserve_The_Value => False); 

To_The_String. The_I tems (1 -. FroiiL_The_Subs tring • Leng th) : = 
FronL.The_Subs tring; 
exception 

when Storage_Error => 
raise Overflow; 
end Copy; 

procedure Clear {The_String ; in out String) is 
begin 

Set(The_String, 

To_The_Size => 0, 

Preseirvejrhe_Value => False); 
end Clear; 

procedure Prepend (The_String : in String; 

To_The_String ; in out String) is 
01d_Length : Natural := To_The_String.The_Length; 

New^Length : Natural := 

To_The_String.The_Length + The_String.The_Length; 

begin 

Se t(To_The_String, 

To_The_Size -> New_Length. 

Preserve_The_Value => True); 

To_The._String.The_Items( (The_String.The_Length + 1) .. 

New_Length) 

:= To_The_String.The_Iterns(1 .. 01d_Length); 

To_The_S tring.The_Items(1 ,. The_String,The_Length) : = 

The_S tring. The_I tems (1 .. The_Str ing. TheJLength) ; 
exception 

when Storage_Error ==> 
raise Overflow; 
end Prepend; 

procedure Prepend (The_Substring : in Substring; 

To_The_String : in out String) is 
OldLLength : Natural := To_The_String.The_Length; 

New_Length : Natural ;= 

To_The_String,The_Length + The_Substring’Length; 

begin 

Set(To_The_String. 


To_The_Size => New_Length, 

Preserve_The_Value => True); 

To_The_String. The_Iteins ((The_Substring' Length + 1) .. 
New_Length) 

:= To_The_String.The_Itenis(l .. 01d_Length) ; 

To_The_String.The_Items(1 .. The_Substring‘Length) := 

The_Subs tring; 
exception 

when Storage_,Error => 
raise Overflow; 
end Prepend; 

procedure Append (The_String : in String; 

To_The_String : in out String) is 
01d_Length : Natural := To_The_String,The_Length; 

NewJLength : Natural := 

To_The_String. The_Length + The^Str ing. The_Length; 

begin 

Set(To_The_String, 

To._The_Size => New_Length, 

Preserve_The_Value => True); 

To„The_String.The_Items( (OldLLength +1) .. New_Length) 

:= The_String.The_ltems(1 .. The_String.The_Length); 
exception 

when Storage_Error =:> 
raise Overflow; 
end impend; 

procedure Aj^end (The_Substring : in Substring; 

To_The_String : in out String) is 
Old_Length : Natural ;= To_The_String.The_Length; 

New_Length : Natural := 

To^The_S tring. The_Length + The_Subs tring ’ Length; 

begin 

Set(To_The_String, 

To_The_Size => New_Length, 

Preserve_The_Value -> True); 

To_The_String.The_Items{(01d_Length +1) .. New_Length) 

;= The_Svibs tring; 
exception 

when Storage_Error => 
raise Overflow; 
end Append; 

procedure Insert (The_String : in String; 

In_The_String : in out String; 

At_The_Position : in Positive) is 

OlcLLength ; Natural := In_The_String.The_Length; 

New_Length ; Natural := 

In_The_String.The_Length + 

The_String.The_Length; 

End_Position ; Natural := 

At_The_Position + The_String.The_Length; 

begin 

if At_The_Position > In_The_String,The_Length then 
raise Position_Error; 

else 

Set{In_The_String, 

To_The_Size => New_Length, 

Preserve_TheJValue => True); 

In_The_String.The_Items(End^Position .. New_Length) := 
ln_The_String.The_Items{At_The_Position .. Old^Length); 
In_The__String.The_Items (At_The_Position .. (End_Position - 

D) : = 

The_S tring. The_I tems (1 .. The_S tring. The_Length) ; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Insert; 

procedure Insert (The_Substring : in Substring; 

In_The_String : in out String; 

At_The_Position : in Positive) is 
01d_Length : Natural := In_The_String.The_Length; 

New_Length : Natural := 

In_The_String.The_Length + 

The_Substring'Length; 

End_Position : Natural := 

At_The_Position + The_S\ibstring‘Length; 

begin 

if At_The_Position > In_The_String.The_Length then 
raise Position_Error; 

else 

Se t {In_The_S tring, 

To_The_Size => New__Length, 

Preserve_The_Value => True); 

In_The_String.The_Items (End_Position .. New_Length) : = 
In_The_String.The_Items(At_The_Position .. 01d„Length) ; 
In The_String.The_Items(At_The_Position .. (End_Position - 

D) : = 

The_Subs tring ; 
end if; 
exception 

when Storage_Error => 
raise Overflow; 
end Insert; 

procedure Delete (In_The_String : in out String; 
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FroitL.The_Position : in Positive; 

To_The_Position : in Positive) is 

New_Length : Natural; 
begin 

if (FronuThe^Position > In_The_String.The_Length) or else 
(To_The_Position > In_The_String.The_Length) or else 
(FroituThe_Position > To_The„Position) then 
raise Position_Error; 

else 

New_Length ;= In_The_String,The_Length - 

(To_The„Position - Froin_The_Position + 1) ; 
In_The_St r ing. The_I tenvs (FronuThe_Pos i tion .. New_Length) 

In_The_String. The_Iteins 

((To_The_Position + 1) .. In_The_String.The_Length); 

Set(In_The_String, 

To_The_Size => New_Length, 

Preserve_The_Value => True); 

end if; 
end Delete; 


procedure Replace (In_The_String : in out String; 

At_The_Position : in Positive; 

With_The_String : in String) is 

End^Position : Natural 

At„The_Position + With_The_String.The_Length - 

1 ; 

begin 

if (At_The_Position > In-.The_String.The_Length) or else 
(EndLPosition > In^The_String.The_Length) then 
raise Position_Error; 

In_The_String.The_Items(At_The_Position .. End_Position) 

With_The_String.The_Items(1 ,. 

Wi th_The_String.The_Length); 
end if; 
end Replace; 


procedure Replace (In_The_String 

At_The_Position 
With_The_Subs tring 
End_Position : Natural := . , 

At_The_Position + With_The_Substring'Length -- 


in out String; 
in Positive; 

in Substring) is 


begin . ^ . 

if (At_The_Position > In_The_String.The_Length) or else 
(End_Position > In_The_String.The_Length) then 
raise Position_Error; 

In_,The_S tr ing. The_I terns (At_The_Position .. End^_Position) 

With_The_Subs tring; 
end if; 
end Replace; 

procedure Set_Itein (In_The_String : in out String; 

At_The_Position : in Positive; 

With^The_Item : in Item) is 

begin 

if At_The_Position > In_The_String.The_Length then 
raise Position_Error; 

In_The_String.The_Iterns{At_The_Position) := With_The_Item; 

end if; 
end Set_Item; 


— modified by Vincent Hong and Tuan Nguyen 

— date: 9 April 1995 

adding procedures to replace functions 


procedure Is^Equal 


begin 

result := Is^Equal 
end Is_Egual; 


{Left 

Right 

Result 

(Left,Right); 


procedure Is_Equal 


begin 

result := Is_Equal 
end Is_Equal; 


{Left 

Right 

Result 

(Left,Right); 


procedure Is_Equal 


begin 

result := Is^Egual 
end Is_Equal; 


(Left 

Right 

Result 

(Left,Right); 


procedure Is_Less_Than 


(Left 

Right 

Result 


begin 

result := Is_Less_Than 
end Is_Less_Than; 


(Left,Right); 


procedure Is_Less_Than 


(Left 

Right 

Result 


begin 

result Is_Less_Than 
end Is_Less_Than; 


(Left,Right); 


procedure Is_Less_Thaun (Left 
Right 


in String; 
in String; 
out Boolean) is 


in Substring; 
in String; 
out Boolean) is 


in String; 
in Substring; 
out Boolean) is 


in String; 
in String; 
out Boolean) is 


in Substring; 
in String; 
out Boolean) is 


in String; 
in Sxabstring; 


Result 

begin 

result := Is_Less_Than (Left,Right); 
end Is_Less_Than; 

procedure Is_Greater_Than (Left 
Right 
Result 

begin 

result := Is_Greater_Than (Left,Right); 
end Is_Greater_Than; 

procedure Is_Greater_Than (Left 
Right 
Result 

begin 

result := Is_Greater_Than (Left,Right); 
end Is_Greater_Than; 


out Boolean) is 


in String; 
in String; 
out Boolean) is 


in Substring; 
in String; 
out Booleein) is 


procedure Is_Greater_Than 


(Left 

Right 

Result 


begin 

result := Is„Greater_Than 
end Is^GreaterJThan; 


(Left,Right); 


procedure Length_Of 
begin 

result := Length_Of 
end Length_Of; 


(The_String 
Result 

{The„String); 


procedure Is^ull (The_String 

Result 

begin 

result Is_Null {The_String); 

end Is_Null; 


in String; 
in Substring; 
out Boolean) is 


in String; 
out Natural) is 


in String; 
out Boolean) is 


procedure ItenuOf 


begin 

result ;= ItenuOf 
end ItenuOf; 


(The_String 
At_The_Position 
Result 


: in String; 

: in Positive; 
: out Item) is 


(The_String,At_The_Position); 


procedure Substring_Of (The_String 

Result 


begin 

result := S\jbstring_Of 
end Substring_Of; 


(The_String) ; 


in String; 

out S\ibstring) is 


procedure Substring_Of (The_String : in String; 

FronuThe_Position ; in Positive; 
To_The_Position : in Positive; 
Result : out Siibstring) is 

begin 

result := . • V 

Substring_Of (The_String,FronuThe_Position,To_The_Position) ; 

end Substring_Of; 


— end of modification 

function Is_Egual (Left ; in String; 

Right : in String) return Boolean is 

begin 

if Left.The_Length /= Right.The_Length then 
return False; 

else 

for Index in 1 .. Left.The_Length loop 

if Left,The_Iterns(Index) /= Right.The_Iterns(Index) 


return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 

function Is_Equal (Left : in Substring; 

Right : in String) return Boolean is 

begin 

if Left'Length /= Right.The_Length then 
return False; 

else 

for Index in 1 .. Left'Length loop 

if Left(Left'First + Index - 1) /= 

Right.The_Iterns(Index) then 

return False; 
end if; 
end loop; 
return True; 
end if; 
end Is_Equal; 

function Is_Equal (Left : in String; 

Right : in SxdDString) return Boolean is 

begin 

if Left.The_Length {- Right'Length then 
return False; 

else 

for Index in 1 .. Left.The_Length loop ^ 

if Left.The_Iterns(Index) /= Right(Right'First + Index 

- 1) then 

return False; 
end if; 
end loop; 
retujm True; 
end if; 
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end Is_Equal; 

fxmction Is_JLess_Than (Left : in String; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left,The_Length loop 
if Index > Right.The_Length then 
return False; 

eisif Left.The_Items(Index) < Right.The_Iterns(Index) then 
return True; 

eisif Right.The_Items(Index) < Left.The_Iterns(Index) then 
return False; 
end if; 
end loop; 

return (Left.The^Length < Right.The_Length); 
end Is_Less_Than; 

function Is_Less_Than (Left : in Substring; 

Right : in String) return Boolean is 

begin 

for Index in 1 .- Left’Length loop 
if Index > Right.The_Length then 
return False; 

eisif Left(Left‘First + Index - 1) < 

Right.The_Iterns{Index) then 
return True; 

eisif Right.The_Iterns(Index) < Left(Left'First + index - 

1) then 

return False; 
end if; 
end loop; 

return (Left'Length < Right.The_Length); 
end Is_Less_Than; 


function ls_Less_Than (Left : in String; 

Right : in Substring) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right'Length then 
return False; 

eisif Left.The_Items(Index) < Right(Right‘First + Index - 

1) then 

return True; 

eisif Right(Right'First + Index - 1) < 

Left. The_Iterns (Index) then 

return False; 
end if; 
end loop; 

return (Left•The_Length < Right'Length); 
end Is_Less_Than; 


end if; 
end loop; 
return False; 
end Is_Greater_Than; 

function Is_Greater_Than (Left ; in String; 

Right ; in Substring) return Boolean is 

begin 

for Index in 1 .. Left.The_Length loop 
if Index > Right‘Length then 
return True; 

eisif Left.The_Items{Index) < Right(Right‘First + Index - 

1) then 

return False; 

eisif Right(Right‘First + Index - 1) < 

Left. The_I terns {Index) then 
return True; 
end if; 
end loop; 
return False; 
end Is_Greater_Than; 

function Length_Of (The_String : in String) return Natural is 
begin 

return The_S tring. The_Leng th ; 
end LengtlL_Of; 

ftinction IsJNull (The_String : in String) return Boolean is 
begin 

return (The_String.The_Length = 0); 
end Is_Null; 

fxinction ItertuOf (The_String : in String; 

At_The_Position ; in Positive) return Item is 

begin 

if At_The_Position > The_String.The_Length then 
raise Position_Error; 

else 

re turn The_S t r ing. The_I terns (A t_The_Pos i t ion) ; 
end if; 
end Iteii\_Of; 

function Substring_Of (Ihe^String ; in String) return Substring is 
Temperary_Strueture : Substring (1 .. 1); 
begin 

return The_String. The_Iterns (1 .. The_String. The_Length); 
exception 

when Constraint_Error => 

return Tenporary_Structure(l .. 0); 
end S\jbstring_Of ; 


function Is_Greater_Than (Left : in String; 

Right : in String) return Boolean is 

begin 

for Index in 1 ., Left.The_Length loop 
if Index > Right.The_Length then 
return True; 

eisif Lef t.The^I terns (Index) < Right .The_I terns (Index) then 
return False; 

eisif Right .The_Iterns (Index) < Lef t.The_Iterns (Index) then 
return True; 
end if; 
end loop; 
return False; 
end ls_Greater_Than; 


function Substring^Of (The_String : in String; 

FronuThe_Position : in Positive; 

To_The_Position : in Positive) return 

Substring is 
begin 

if {Froit\_The_Position > The_String.The_Length) or else 
(To_The_Position > The_String.The_Length) or else 
{Froin_The_Position > To_The_Position) then 
raise Positior^L^Error; 

else 

return The_String.The_Iteins(FroitL.The_Position .. 
To_The_Position); 
end if; 

end Substring^Of; 


function Is_Greater_Than (Left : in Substring; 

Right : in String) return Boolean is 

begin 

for Index in 1 .. Left‘Length loop 
if Index > Right.The^Length then 
return True; 

eisif Left(Left'First + Index - 1) < 

Right. The_Iterns (Index) then 

return False; 

eisif Right .The_I terns (Index) < Left (Left‘First + Index -- 

1) then 

return True; 


procedure Iterate (Over_The_String : in String) is 
Continue : Boolean; 
begin 

for The_Iterator in 1 .. Over_The_String.The_Length loop 
Process (Over_The_String.The_Iterns (The_Iterator), 

Continue); 

exit when not Continue; 
end loop; 
end Iterate; 

end String_Sequential_UnboundecLUnmanaged_Iterator; 
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STRING SEQUENTIAL UNBOUNDED UNMANAGED ITERATOR 

PSDL 


TYPE string_Seguential_Unboimde<a_Uninanaged_Iterator 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TYPE, , . 

Sxabstring : ARRAY[ARRAY_ELEMENT : Item, ARRAY_INDEX : Positive], 
£unc_“<" : FUNCTION [Left : Item, Right : Item, RETURN : Boolean] 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroitL.The_String : String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Copy 
SPECIFICATION 
INPUT 

From_The_Substring : Substring, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_String : String 
OUTPUT 

The^String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Prepend 
SPECIFICATION 
INPOT 

The_String : String, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Prepend 
SPECIFICATION 
INPUT 

The^Substring : Substring, 

To_The_String : String 
OUTPUT 

To_Tlie_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Append 
SPECIFICATION 
INPUT 

The^String : String, 

ToJThe^String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Append 
SPECIFICATION 
INPUT 

The_Substring : Substring, 

To_The_String : String 
OUTPUT 

To_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Insert 
SPECIFICATION 
INPUT 

The_String : String, 
In_The_String : String, 
At_The_Position : Positive 
OUTPUT 

In_The_String ; String 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Insert 
SPECIFICATION 
INPUT 

The_Substring : Substring, 
ln^The_String : String, 


At_The_Position : Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Delete 

SPECIFICATION 

INPUT 

In_The_String : String, 
FroirL_The_,Position : Positive, 
To_The_Position : Positive 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Replace 

SPECIFICATION 

INPUT 

In_The_String : String, 
At_The_Position : Positive, 
With_The_String ; String 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Replace 

SPECIFICATION 

INPUT 

In_The_String : String, 
At_The_Position : Positive, 
With_The_Substring : Substring 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position^Error 

END 

OPERATOR Set_Item 

SPECIFICATION 

INPUT 

In_The_String : String, 
At_The_Position : Positive, 
With_The_Item : Item 
OUTPUT 

In_The_String : String 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is^Equal 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR IS_Equal 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 


OPERATOR Is_Equal 

SPECIFICATION 

INPUT 

Left : String, 

Right : Substring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left ; String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 
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OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left : Substring, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Less_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : Sxibstring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : S\ibstring, 

Right : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Is_Greater_Than 

SPECIFICATION 

INPUT 

Left : String, 

Right ; Substring 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Length_Of 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result ; Natural 


EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR IS_Null 

SPECIFICATION 

INPUT 

The_String : String 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR IteitL.Of 

SPECIFICATION 

INPUT 

The_String : String, 

At_The_Position ; Positive 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, PositiorL.Error 

END 

OPERATOR Siabstring_Of 

SPECIFICATION 

INPUT 

The_String ; String 
OUTPUT 

Result : Substring 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Substring_„Of 

SPECIFICATION 

INPUT 

The^String : String, 

Front_The_Position : Positive, 

To_The_Position : Positive 
OUTPUT 

Result : S\jbstring 
EXCEPTIONS 

Overflow, Position_Error 

END 

OPERATOR Iterate 

SPECIFICATION 

GENERIC 

Process : PROCEDURE[The_Item ; in It : Item], Continue ; outtt 
Boolean]] 

INPUT 

Over_The_String ; String 
EXCEPTIONS 

Overflow, Position_Error 

END 

END 

IMPLEMENTATION ADA String_Sequential_Unbounded_Uninanage(a_Iterator 
END 
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TREE ARBITRARY DOUBLE UNBOUNDED MANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 

ExpectedJJuinber_Of_Children : in Positive; 
package Tree..jArbitrary_DoulDle^Unbounded_Jlanaged is 


type Tree 

is private 





Null_Tree 

: constant 

Tree; 




procedure 

Copy 

{From_The_Tree 

in 


Tree; 

To_The_Tree 

in 

out 

Tree); 

procedure 

Clear 

{The^Tree 

in 

out 

Tree); 

procedure 

Construct 

(The_Item 

in 


I tern; 


And^The_Tree 

in 

out 

Tree; 



Number^Of_ChiIdren 

in 


Natural; 



OruThe_Child 

in 


Natural) 

procedure 

Set_Item 

{Of_The_Tree 

in 

out 

Tree; 


To_The_Item 

in 


Item) ; 

procedure 

Swap^Child 

(The_Child 

in 


Positive 


Of_The_Tree 

in 

out 

Tree; 



And_The_Tree 

in 

out 

Tree); 


procedure Nijmber_Of_Children_In 

(The^Tree 

; in Tree; 


Result . 

: out Natural) 

; 

procedure Child_Of 

— end of modification 

(The_Tree 

Ihe^Child 

Result 

: in Tree; 
in Positive; 

: out Tree); 


function Is_Egual 

(Left 

in Tree; 


Booleeui; 

Right 

in Tree) 

return 

function ls_Null 

Boolean; 

{The_Tree 

in Tree) 

return 

fxinction Item_Of 

(The_Tree 

; in Tree) 

return 

Item; 

function Number_Of_Children_In 
Natural; 

{The_Tree 

; in Tree) 

return 

function Child_Of 

{The_Tree 

; in Tree; 


Tree; 

function Parent_Of 

Tree; 

The_Child ; 

; in Positive) 

return 

(The_Tree 

1 in Tree) 

return 


— modified by Tuan Nguyen 

— 25 December 1995 

— adding procedures to replace functions 

procedure Is_Equal (Left 

Right 

Result 

procedure Is_Null (The^Tree 

Result 

procedure ItenuOf (The^Tree 

Result 


in Tree; 
in Tree; 
out Boolean); 
in Tree; 
out Boolean); 
in Tree); 
out Item); 


Overflow 
Tree_Is_Null 
Tree_Is_Not_Nu11 
Not^t_Root 
ChildLError 


exception; 

exception; 

exception; 

exception; 

exception; 


private 

type Node; 

type Tree is access Node; 

Null_Tree : constant Tree := null; 
end Tree_jArbi trary_Double_Unbounded_Nanaged; 
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TREE ABBITRARYDOUBLE UNBOUNDED MANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

■Restricted Rights Legend* 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in sid^ivision (b) (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

wi th Map_S inpl eJJoncached_Sequent ia l_UnboundedJlanaged_I terator, 
Storage_Manager_Sequential; 

package body Tree_Arbitrary_Doiible_UnboxandecLJManaged is 

function Hash_Of (The_Child : in Positive) return Positive; 
package Children is new 

Map_Sinple_J^oncachedLSequential_Unbo\indedJManaged_Iterator 
(Domain => Positive, 

Ranges => Tree, 

Number_Of_Buckets => Expected_Nuinber_Of_^Children, 

HashuOf => Hash^Of); 

type Node is 
record 

Previous : Tree; 

The_Item : Item; 

The_Children : Children.Map; 

Next : Tree; 

end record; 

function Hash_Of (The_Child : in Positive) return Positive is 
begin 

return The_Child; 
end Hash-Of; 

procedure Free (The_Node : in out Node) is 
begin 

The_Node.Previous := null; 

Children.Clear(The_Node.The_Children); 
end Free; 

procedure Set_Next (TheJJode ; in out Node; 

ToJ^Iext : in Tree) is 

begin 

TheJNode. Next : = ToJNext ; 
end Set_Next; 

function Next_Of (TheJMode : in Node) return Tree is 
begin 

return The_Node.Next; 
end Next_Of; 

package NodeJManager is new Storage_Manager_Sequential 

(Item => Node, 

Pointer => Tree, 

Free => Free, 

Set^Pointer => Set^ext, 
Pointer_Of => Next_Of); 

procedtore Copy (From_The_Tree : in Tree; 

To_The_Tree : in out Tree) is 
procedure Copy_Child (The_Domain : in Positive; 

The_Range : in Tree; 

Continue : out Boolean) is 
Temporary JNode : Tree; 
begin 

Copy{The_Range, To_The_Tree => Teinporary_Node) ; 

Children .Bind (The_Doinain, Temporary^NocSe, 

In_TheJMap => To_The„Tree .The_Children) ; 
if Temporary^Node /= Null_Tree then 

Temporary^^ode. Previous : = To^The_Tree; 
end if; 

Continue := True; 
end Copy_Cfaild; 

procedure Copy_Children is new Children.Iterate(Copy_ChiId); 
begin 

Clear(To_The_Tree); 
if FroiiuThe_Tree /= null then 

To_The_Tree : = Node_Manager. New_I tern; 
To_The_Tree.The_ltem := Fronvjrhe_Tree.The_Item; 
Copy_Children(From_The_Tree.The_Children); 
end if; 
exception 

when Storage__Error | Children.Overflow s> 
raise Overflow; 
end Copy; 

procedure Clear (The^Tree : in out Tree) is 

procedure Clear_Child (The_Domain : in Positive; 

The_Range : in Tree; 

Continue : out Boolean) is 

Teinporary_Node : Tree := The_Range; 
begin 


Clear {Tenporary^ode); 

Continue := True; 
end Clear_Child; 

procedure Clear_Children is new Children.Iterate(Clear^Child); 
begin 

if The_Tree /= null then 

Clear_Children(The_Tree.The_Children); 

NodeJMamager.Free(The_Tree); 
end if; 
end Clear; 

procedure Construct (The^Item : in Item; 

AncLThe_Tree : in out Tree; 

Number_Of_Children : in Natural; 

On_The_Child : in Natural) is 

TeitporaryJMode : Tree; 
begin 

if Nuinber_Of_Children = 0 then 
if And_The_Tree = null then 

AndL_The_Tree := Node_Manager .New__Item; 
AndLThe_Tree.The_Item := The_ltem; 
return; 
else 

raise Tree_Is_Not_Null; 
end if; 

elsif Onjrhe_Child > Number_Of_Children then 
raise ChilcLError; 
elsif An(3LThe_Tree = null then 

And_The_Tree := Nodejlanager .New_Item; 
And_'Ihe_Tree.The_Item := The_Item; 
for Index in 1 .. Number_Of_Children loop 
Children,Bind(The_Domain => Index, 

AncLThe_Range => null, 

In_TheJKap => 

And_The_Tree.The_Children); 
end loop; 

elsif And_The_Tree.Previous = null then 

Tenporary_Node := Node.Jl 2 uiager .New_Item; 

Tenporary_Node.The_Item ;= The_Item; 
for Index in 1 .. Number_Of_Children loop 
if Index = OrL_The_Child then 
Children.Bind 

(TheJ3omain => Index, 

And^The_Range => And^The_Tree, 

In-The_Map *> Teiiporary_Node.The^Children); 

else 

Children.Bind 

(The^Domain => Index, 

And_The_Range => null, 

In_The_Map => Temporary_Node,The_Children); 

end if; 
end loop; 

Anc3LThe_Tree. Previous ; = Tenporary_Node; 

AncLThe_Tree ;= TeitporaryJNode; 

else 

raise Not_At_Root; 
end if; 
exception 

when Storage_Error | Children.Overflow => 
raise Overflow; 
end Construct; 

procedure Set_Item (Of_The_Tree : in out Tree; 

To_The_Item : in Item) is 

begin 

Of_The_Tree.The_Item ;= To_The_Item; 
exception 

when Constraint_„Error => 
raise Tree_Is_Null; 
end Set_Item; 

procedure Swap_Child (The_Child : in Positive; 

Of_The_Tree : in out Tree; 

And^The_Tree : in out Tree) is 
Teitporary_Node : Tree; 
begin 

if And_The_Tree = null then 

Tenporary_Node := Children.REuige_Of 

(The_Doinain => The_Chiid, 

In_The^ap => 

Of_The_Tree. The__Children) ; 

Children.Unbind{The_Child, Of_The_Tree.The_Children); 
Children.Bind(The_Domain => The_Child, 

AncLThe_Range => null, 

In_The_Map => Of_The_Tree.The_Children); 
if Temporary_Node /= null then 

Temperary_Node.Previous := null; 
end if; 

And_The_Tree :* Temporary_Node; 
elsif And_The_Tree.Previous = null then 
Teiiporary_Node Children.Range_,Of 

(The_Domain => The_Child, 

In_TheJ4ap s> 

Of_The_Tree.The_Children); 

Children.Unbind(The_Child, Of_The_Tree .The_Children); 
Children.Bind(The_Domain => The_Child, 

And_The_Range => And_The_Tree, 

In_The_Map => Of_The_Tree,The_Children); 
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if Teirporary_Node /= null then 

Tenporary^ode. Previous : = null; 
end if; 

And_The_Tree.Previous := Of_The_Tree; 
And_The_Tree := Teii^orary_Node ; 

else 

raise Not_At_Root; 
end if; 
exception 

when Constraint_Error => 

raise Tree_Is_Null; 
when Children,Domain_IsJNot_Bound => 
raise Child-Error; 
end Swap_Child; 


— modified by Tuan Nguyen 

— 25 December 1995 

adding procedures to replace functions 

procedure Is__Equal (Left 

Right 

Result 

begin 

Result := Is_Equal(Left,Right); 
end Is_,Egual; 

procedure Is_Null (The_Tree 

Result 

begin 

Result ;= Is_Null{The_Tree); 
end Is-Null; 

procedure ItenuOf (The_Tree 

Result 

begin 

Result := Item-Of(The_Tree); 
end IteirL_Of; 


in Tree; 
in Tree; 
out Boolean) is 


in Tree; 

out Boolean) is 


in Tree); 
out Item) is 


procedure Number_Of_Children_In (The_Tree 

Result 


in Tree; 

out Natural) is 


begin 

Result :~ Number^Of_Children„In(The_Tree); 
end Nuinber_Of_Children_In; 


else 

Continue := True; 
end if; 

end Check_Child-Equality; 
procedure Check_E<^ality is new 
Children.Iterate(Check_Child_Equality); 
begin 

if Left.The_Item /= Right.The_Itern then 
return False; 

if Children.Extent^Of(Left.The^Children) /= 

Children.Extent_Of(Right.The_Children) then 
return False; 

else 

Check^Equality{Left.The^Children); 
return Trees^Are_Equal; 
end if; 
end if; 
exception 

when Constraint_Error *> 

return (Left = Null_Tree) and (Right = Null_Tree); 
end Is_Equal; 

function Is_Null (The_Tree : in Tree) return Boolean is 
begin 

return (The_Tree = null); 
end IsJJull; 


function IteirL.Of (The_Tree : in Tree) return Item is 
begin 

return The_Tree.The_Item; 
exception 

when Constraint_Error «> 
raise Tree_Is_JIull; 
end IteituOf; 

function Nurciber_Of_Children_In (The_Tree : in Tree) return Natural 
begin 

re turn Children. Ext ent_0 f {The_Tr e e. The_Chxldren) ; 
exception 

when Constraint„Error => 
raise Tree_IsJIull; 
end Nuinber-.Of_Children_In; 


procedure ChildLOf (The_Tree : in Tree; 

The_Child : in Positive; 

Result : out Tree) is 

begin 

Result := ChiIcLOf(The_Tree,The_ChiId); 
end Child-Of; 

— end of modification 

function Is_Equal (Left : in Tree; 

Right ; in Tree) return Boolean is 
TreeS-Are_Equal ; Boolean := True; 

procedure Check^Child^Equality (The_Domain : in Positive; 

The^Range : in Tree; 

Continue : out Boolean) is 

begin 

if not Is_Equal(The_Range, 

Children.Range_Of(The_Domain, 

Right.The_Children)) 

then 

Trees^Are„Equal ;= False; 

Continue ;= False; 


function Child__Of (The_Tree : in Tree; 

The_Child ; in Positive) return Tree is 

begin 

return Children.Range_Of(The_Domain => The_Child, 

In_The_Map => The_Tree.The_Children); 

exception 

when Constraint_Error => 

raise Tree_IsJNull; 
when Children.Domain_ls_JIot_Boxmd => 
raise Child^Error; 
end Child_Of; 

fxjnction Parent_Of (The^Tree ; in Tree) return Tree is 
begin 

return The_Tree.Previous; 
exception 

when Constraint_Error => 
raise Tree_Is_Null; 
end Parent_Of; 

end Tre e-Arbi trary_Double-Unbounded_^anaged; 
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TREE ARBITRARY DOUBLE UNBOUNDED MANAGED 


PSDL 


TYPE Tree^Arbi trary_Doubie_Uiibouiided^Managed 
SPECIFICATION 
GENERIC 

Item : PRIVATE^TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Fromjrhe_Tree : Tree, 

To__The_Tree : Tree 
OUTPUT 

To_The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_Null, NotJvt_Root, 
ChildLError 
END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Tree ; Tree 
OUTPUT 

The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_IsJNot_Null, Not_At_Root, 
ChildLError 
END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The^Item : Item, 

AndLThe_Tree : Tree, 

Number_Of_Children : Natural, 

On_The_Child ; Natural 
OUTPUT 

And_The_Tree ; Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_Null, NotLAt_Root, 
ChildLError 
END 


OPERATOR Set_Item 
SPECIFICATION 
INPUT 

Of_The_Tree : Tree, 

To_The_Item : Item 
OUTPUT 

Of_The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_ISLNull, Tree_Is_Not_Null, NotLAt_Root 
ChildLError 
END 

OPERATOR Swap_Child 
SPECIFICATION 
INPUT 

The_Child : Positive, 

Of_The_Tree : Tree, 

AncL.The_Tree : Tree 
OUTPUT 

Of_The_Tree : Tree, 

And_The_Tree ; Tree 
EXCEPTIONS 


Overflow, Tree_Is_Null, Tree_Is_Not_Null, NotJAt_Root, 
ChildLError 
END 

OPERATOR IS_Egual 
SPECIFICATION 
INPUT 

Left : Tree, 

Right : Tree 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_Null, NotLAt_Root, 
ChildLError 
END 

OPERATOR Is_JIull 
SPECIFICATION 
INPUT 

The_Tree : Tree 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Tree_IsJN'ull, Tree_IsJNot_Null, NotLAt_Root, 
ChildJError 
END 

OPERATOR ItenuOf 
SPECIFICATION 
INPUT 

The_Tree : Tree 
OUTPUT 

Result ; Item 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is^ot_Null, Not_At_Root, 
ChildLError 
END 

OPERATOR Number_Of_Children_In 
SPECIFICATION 
INPUT 

The_Tree : Tree 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Tree_IsJIull, Tree_Is_NotJNull, Not_At_Root, 
Child_Error 
END 

OPERATOR ChilcLOf 
SPECIFICATION 
INPUT 

The_Tree : Tree, 

The_Child ; Positive 
OUTPUT 

Result : Tree 
EXCEPTIONS 

Overflow, Tree_IsJJull, Tree_Is_>IotJNull, NotLAt_Root, 
ChildLError 
END 

END 

IMPLEMENTATION ADA TreeLArbitrary_Double_Unbo;mdedJManaged 
END 
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TREE ARBITRARY DOUBLE UNBOUNDED UNMANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 

EbqpectedJJioirtoer.Of .Children : in Positive; 
package Tree^Arbitrary_Dovible_Unbounded_Unmanaged is 


type Tree 

is private; 





Null.Tree 

: constant 

Tree; 




procedure 

Copy 

(From_The_Tree 

in 


Tree; 


To.The.Tree 

in 

out 

Tree); 

procedure 

Clear 

(The.Tree 

in 

out 

Tree); 

procedure 

Construct 

(The.Item 

in 


Item; 


And.The_Tree 

in 

out 

Tree; 



Number.Of.Children 

in 


Natural; 



Qn.The.Child 

in 


Natural) 

procedure 

Set.Item 

(Of.The.Tree 

in 

out 

Tree; 


To.The.Item 

in 


Item); 

procedure 

Swap.Child 

(The.Child 

in 


Positive 


Of.The.Tree 

in 

out 

Tree; 



And^The.Tree 

in 

out 

Tree); 


procedure Number.Of.Children.In 

, (The.Tree 

: in Tree; 

Result 

: out Natural) 

procedure Child.Of 

(The.Tree 

: in Tree; 

The.Child : 

: in Positive; 


Result 

: out Tree); 

— end of modification 

function Is.Equal 

(Left 

: in Tree; 


Right 

: in Tree) 

Boolean; 

function Is.Null 

(The.Tree 

: in Tree) 

Boolean; 

function Item_Of 

(The.Tree 

: in Tree} 

Item; 

function Number.Of.Children.In 

(The.Tree 

: in Tree) 

Natural; 

function Child_Of 

(The.Tree 

: in Tree; 


The.Child ; 

; in Positive) 

Tree; 

function Parent.Of 

(The.Tree 

: in Tree) 

Tree; 


— modified by Tuan Nguyen 

— 25 December 1995 

— adding procedures to replace functions 


procedure Is.Equal 


procedure Is.Null 
procedure ItenuOf 


(Left 

Right 

Result 

(The.Tree 

Result 

(The.Tree 

Result 


in Tree; 
in Tree; 
out Boolean); 
in Tree; 
out Boolean); 
in Tree); 
out Item); 


Overflow 
Tree.IsJJull 
Tree_Is.NotJNul1 
Not_At.Root 
Child_Error 


exception; 

exception; 

exception; 

exception; 

exception; 


private 

type Node; 

type Tree is access Node; 

Null.Tree : constant Tree := null; 
end Tre e.Arbi trary.Double.Unbounded.Unmanaged; 


return 

return 

return 

return 

return 

return 
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TREE ARBITRARY DOUBLE UNBOUNDED UNMANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Nuntoer 0100219 

— "Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Computer 

— Software Clause of FAR 52.227-7013. Manufacturer; 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Map_SinpleJIoncached_Sec 3 uential_Unbounded^Uninanage<^Iterator ; 
package body Tree_J^bitrary_Double_Unboundec5LUnmanaged is 

function Hash_Of (The_Child ; in Positive) return Positive; 

package Children is new 

Map_Siinple_J4oncached>.Sequential_UnboimdedLUnin2inagedLlterator 
(Domiain => Positive, 

Ranges => Tree, 

Nuinber_Of_Buckets => Expected_^Iuinber_Of_Children, 

Hash_0f => Hash_0f); 

type Node is 
record 

Previous : Tree; 

The_Item ; Item; 

The_Children ; Children.Map; 
end record; 

function Hash_Of (The_Child : in Positive) return Positive is 
begin 

return The_Child; 
end HaslL_Of; 

procedure Copy (FronuThe_Tree : in Tree; 

To_The_Tree : in out Tree) is 

procedure Copy^Child (The_Domain : in Positive; 

The_Range : in Tree; 

Continue : out Boolean) is 

Teinporary_Node : Tree ; 
begin 

Copy (The_Range, To_Thc_Tree => Teinporary_^ode) ; 

Children-Bind(The„Doinain, Tenporary_^ode, 

In_The_Map => To_The_Tree.The_Children); 
if Temporary^Node /= Null_Tree then 

TenporaryJMode. Previous ; = To_The_Tree ; 
end if; 

Continue := True; 
end Copy_Child; 

procedure Copy^Children is new Children.Iterate(Copy_Child) ; 
begin 

if FroituThe_Tree = null then 
To_The_Tree := null; 

else 

To_The_Tree ;= new Node; 

To_The_Tree,The_ltein := Fronv_The_Tree.The_Item; 
Copy_Children {Froin_The_Tree. The_Children); 
end if; 
exception 

when Storage^Error | Children.Overflow => 
raise Overflow; 
end Copy; 

procedure Clezu: (The^Tree : in out Tree) is 
begin 

The_Tree ;= null; 
end Clear; 

procedure Construct (The_Item ; in Item; 

An(i„The_Tree : in out Tree; 

Ntunber_Of_Children ; in Natural; 

On_The_Child ; in Natural) is 

Ten^orary^Node : Tree; 
begin 

if Nuinber_Of_Children = 0 then 
if And_The_Tree = null then 
And_The_Tree := new Node; 

And_The_Tree.The_Item := The_Item; 
return; 
else 

raise Tree_Is_Not_Null; 
end if; 

elsif On_The_Child > Nuinber_0£_Children then 
raise Child^Error; 
elsif And^The_Tree = null then 
AndJThe^Tree ;= new Node; 

AncLThe_Tree .The_Item := The_Item; 
for Index in 1 .. Number^Of..Children loop 
Children.Bind(The_Domain => Index, 

AndL_The_Range => null, 

In_TheJMap => 

AncSLThe_Tree.The_Children) ; 
end loop; 

elsif AndLThe_Tree.Previous = null then 


TemporaryJlode := new Node; 

Teiiporary_Node .The_Item ;= The_Item; 
for Index in 1 ,. Nurnber_Of_Children loop 
if Index = On_The_Child then 
Children.Bind 

(The_Domain => Index, 

And_The_Range => And_The_Tree, 

In_The_Map => Temperary_Node.The_Children) ; 

else 

Children.Bind 

(The^Domain => Index, 

And_The_Range => null, 

In_The_Map => TemperaryJNode.The_Children); 

end if; 
end loop; 

AncLThe_Tree. Previous : = Temperary_Node ; 

AndLThe_Tree := Temperary^Node; 

else 

raise Not..At_Root ; 
end if; 
exception 

when Storage_Error | Children.Overflow => 
raise Overflow; 
end Construct; 

procedure Set_Item {Of_The_Tree : in out Tree; 

To_The_Item : in Item) is 

begin 

Of_The_Tree.The_Item := To_The_Item; 
exception 

when Constraint_Error => 
raise Tree_Is_Nnll; 
end Set^Item; 

procedure Swap_Child (The_Child : in Positive; 

Of_The_Tree : in out Tree; 

And_The_Tree : in out Tree) is 
TemporaryJlode : Tree ; 
begin 

if And_The_Tree = null then 

Tenporary_Node := Children.Range_Of 

(The_Domain => The^Child, 

In_TheJIap => 

Of_The_Tree.The_Children); 

Children.Unbind{The_Child, Of_The_Tree.The_Children) ; 
Children. Bind (The_Domiain => The_ChiId, 

And_The_Range => null, 

In_The_Map -> Of_The_Tree.The_Children); 
if TemporaryJJode /= null then 

Temporary_Node.Previous := null; 
end if; 

AncLThe^Tree :== Teirporary_Node; 
elsif And_The_Tree.Previous = null then 
TemporaryJJode := Children.Range_Of 

{The_Domain => The_Child, 

In_The_Map -> 

Of_The_Tree. The_Chi Idren) ; 

Children.Unbind(The_Child, Of_The_Tree.The_Children); 
Children. Bind (TheJDomain = > The_ChiId, 

And_The_Range s=> AncSLThe_Tree, 

In_The_Map -> Of_The_Tree .The^Children); 
if Temperary JNode /= Null_Tree then 
Temporary_Node.Previous := null; 
end if; 

AncLThe_Tree.Previous := Of_The_Tree; 

And_The_Tree ;= Temper ary JNode; 
else 

raise NotJ^t_Root; 
end if; 
exception 

when Constraint_Error => 

raise Tree_Is_Null; 
when Children.DomainalsJJot_Bound => 
raise Child-Error; 
end Swap—Child; 

— modified by Tuan Nguyen 

— 25 December 1995 

— adding procedures to replace functions 

procedure Is_Equal (Left : in Tree; 

Right : in Tree; 

Result : out Boolean) is 

begin 

Result ;= Is_Equal(Left,Right); 
end Is_Equal; 

procedure Is.^ull (The^Tree : in Tree; 

Result : out Boolean) is 

begin 

Result := IsJIull (The_Tree) ; 
end IsJJull; 

procedure ItemuOf (The_Tree : in Tree); 

Result ; out Item) is 

begin 

Result := Itemt-Of (The_Tree); 
end Item_0f; 
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procedure Nuitiber_Of_Children_In (The_Tree : in Tree; 

Result ; out Natural) is 


when Constraint_Error -> 

return {Left = Null_Tree) and (Right * Null_Tree); 
end Is_Equal; 


begin 

Result ; = Nuinber_0f_ChiIdren_In (The_Tree) ; 
end Nuinber_Of_Children_In; 


procedure ChilcLOf 


(The_Tree : 
The_Child : 
Result : 


begin 

Result := 
end Child_Of; 


Child^Of(The_Tree,The_Child}; 


in Tree; 
in Positive; 
out Tree) is 


end of modification 


function Is_Null (The_Tree ; in Tree) return Boolean is 
begin 

return (The_Tree = null); 
end Is_^ull; 

function IteirL_Of {The_Tree : in Tree) return Item is 
begin 

return The_Tree.The_Item; 
exception 

when Constraint_Error => 
raise Tree_Is_jNull; 
end IteiruOf; 


function Is_Equal (Left : in Tree; 

Right ; in Tree) return Boolean is 
Trees.J^e_Egual : Boolean := True; ^ _ 

procedure Check_Child_Equality (The_Doinain : in Positive; 

The_Range : in Tree; 

Continue : out Boolean) is 

begin 

if not Is_Equal(The_Range, 

Chi Idren. Range^Of {The_Doinain, 

Right.The_Children)) 


then 

Trees_Are_Equal := False; 
Continue := False; 


else 

Continue := True; 
end if; 

end Check_Child_Equality; 
procedure Check__Equality is new 
Children.Iterate(Check_Child_Eguality); 
begin 

if Left.The_Item /= Right.The_Itern then 
return False; 


if Children.Extent_Of(Left.The_Children) /= 

Children.Extent^Of(Right.The_Children) then 
return False; 

else 

Check_Equality(Left.The_ChiIdren); 
return Trees^Are_Equal; 
end if; 
end if; 
exception 


fiinction Nuinber_Of_Children_In (The_Tree : in Tree) return Natural 
begin 

return Children.Extent_Of(The_Tree.The_Children); 
exception 

when Constraint^Error => 
raise Tree_IsJJull; 
end Number_Of_Children_In; 


function Child^Of (The^Tree : in Tree; 

The_Child ; in Positive) return Tree is 

begin 

return Chi Idren. Range^O f (The^Domain => The^Child, 

In_The_Map => The_Tree.The_Children); 

exception 

when Constraint_Error => 

raise Tree_Is_Null; 
when Children.Domain_Is_Not_Bound => 
raise ChildLError; 
end ChilcLOf; 

function Parent_Of (The^Tree : in Tree) return Tree is 
begin 

return The_Tree.Previous; 
exception 

when Constraint_Error => 
raise Tree^Is_JJull ; 
end Parent_Of; 

end Tree_^bitrary_Double_Unbounded_Uninanaged; 
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TREE ARBITRARY DOUBLE UNBOUNDED UNMANAGED 


PSDL 


TYPE Tree_Arbitrary_Double_UiiboundedLUnmanaged 
SPECIFICATION 
GENERIC 

Item : PRIVATE„TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Fromjrhe_Tree ; Tree, 

To_The_Tree : Tree 
OUTPUT 

To_The__Tree ; Tree 
EXCEPTIONS 

Overflow, Tree_Is__Null, Tree_Is_Not_Null, Not_At_Root, 
Child^Error 
END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The^Tree : Tree 
OUTPUT 

The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree^IsJJull, Tree_Is^ot_Null, Not^t_Root, 
ChildLError 
END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_Item : Item, 

And_The_Tree : Tree, 

N\jmber_Of_Children : Natural, 

On_The_Child : Natural 
OUTPUT 

AncSLThe_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_NotJNull, Not^t_Root, 
Child^Error 
END 

OPERATOR Set_Item 
SPECIFICATION 
INPUT 

Of_The_Tree : Tree, 

To_The_Item : Item 
OUTPUT 

Of_The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_.Null, Tree_Is_Not_Null, Not_At_Root, 
Child^Error 
END 

OPERATOR Swap_Child 
SPECIFICATION 
INPUT 

■nie^Child : Positive, 

Of_The_Tree ; Tree, 

And_The_Trce : Tree 
OUTPUT 

Of_The_Tree : Tree, 

And_The_Tree : Tree 
EXCEPTIONS 


Overflow, Tree_Is_Null, Tree_Is_Not.JIull, Not_jAt_Root, 
Child^Error 
END 

OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Tree, 

Right : Tree 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Tree_IsJNull, Tree_Is_Not__Null, Not_At_Root, 
Child^Error 
END 

OPERATOR Is_Null 
SPECIFICATION 
INPUT 

The_Tree : Tree 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Tree_Is_^ull, Tree_Is_Notjaull, Not_At_Root, 
Child^Error 
END 

OPERATOR IteiTL^Of 
SPECIFICATION 
INPUT 

TheJTree : Tree 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_lsJTotJNull, Not_At_Root, 
Child^Error 
END 

OPERATOR Nuniber_Of_Children_In 
SPECIFICATION 
INPUT 

TheJTree : Tree 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Tree_Is_JJull, Tree_Is_Not_Null, Not^t_Root, 
Child_Error 
END 

OPERATOR Child_Of 
SPECIFICATION 
INPUT 

TheJTree : Tree, 

The_Child : Positive 
OUTPUT 

Result : Tree 
EXCEPTIONS 

Overflow, Tree_IsJMull, Tree_Is^otJNull, Not_At_Root, 
Child^Error 
END 

END 

IMPLEMENTATION ADA Tree_Arbitrary_Double_UnboundecaLUnmanaged 
END 
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TREE ARBITRARY SINGLE UNBOUNDED MANAGED 


ADA SPECIFICATIONS 


generic 

type Item is private; 

Expecte(i_Nuinber_Of_Children : in Positive; 
package Tree_JU‘bitrarY_Single_UnboundedJ!anaged is 

type Tree is private; 


Result 

procedure Number_Of_Children_In (The^Tree 

Result 

procedure ChildLOf (The_Tree 

The_Child 

Result 

end of modification 


: out Item) ; 

; in Tree; 

: out Natural) ; 
: in Tree; 

; in Positive; 

; out Tree); 


Null_Tree : constant Tree; 


procedure Copy 

procedure Clear 
procedure Construct 


procedure Set_Item 
procedure Swap_Child 


{FronL_'llie_Tree 
To_The_Tree 
(The_Tree 
(The_Item 
AndLThe_Tree 
Number^O f_Ch i Idren 
On_The__Child 
(Of_The_Tree 
To_The_Item 
{The_Child 
Of_The_Tree 
And_The_Tree 


in Tree; 
in out Tree); 
in out Tree); 
in I tern; 
in out Tree; 
in Natural; 
in Natural) ; 
in out Tree; 
in Item) ; 
in Positive; 
in out Tree; 
in out Tree); 


— modified by Tuan Nguyen 

— 25 December 1995 

— adding procedures to replace fimctions 


fxanction 

Boolean; 

function 

Boolean; 

function 

Item; 

function 
Natural; 

function 


Is^Egual 

{Left 

Right 

: in Tree; 

: in Tree) 

return 

Is_Null 

(The^Tree 

: in Tree) 

return 

ltem_of 

{The_Tree 

: in Tree) 

return 

Nuinber_Of_Chi Idr en_In 

(The^Tree 

: in Tree) 

return 

ChildLOf 

(The_Tree 
The^Child ; 

: in Tree; 

: in Positive) 

return 


Tree; 


Overflow 
Tree_Is_Null 
Tr ee_I s_No t JNul 1 
ChildLError 


exception; 

exception; 

exception; 

exception; 


procedure Is^Equal 

procedure Is^ull 
procedure IterrL_Of 


{Left 

Right 

Result 

(The„Tree 

Result 

{The_Tree 


in Tree; 
in Tree; 
out Boolean); 
in Tree; 
out Boolean); 
in Tree); 


private 

type Node; 

type Tree is access Node; 

Null^Tree : constant Tree := null; 
end TreelArbitrary_Single_UnboundedJlanaged; 
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TREE ARBITRARY SINGLE UNBOUNDED MANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 


if The^Tree /= null then 

Clear_ChiIdren(The_Tree.The_ChiIdren); 
Node_Nanager.Free{The_Tree); 
end if; 
end Clear; 


"Restricted Rights Legend" 

— Use, duplication, or disclosure is sxibject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data and Conputer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Map_SinpleJJoncachedLSe<^ential_Unbo\inded_Managed_Iterator, 
Storage_Manager_Sequential; 

package body Tree_Ai^bitrary_Single_UnboundecLManaged is 

function Hash^Of (The_Child : in Positive) return Positive; 
package Children is new 

Map_Simple_Noncached_Sequential_Unbounded_Maiiasre^Iterator 
(Domain => Positive, 

Ranges => Tree, 

Nxainber_Of_Buckets => Expected_Number_Of_ChiIdren, 

Hash_Of => Hash_Of); 

type Node is 
record 

The_Item 
The_ChiIdren 
Next 

end record; 

function Hash_Of (The_Child : in Positive) return Positive is 
begin 

return The_Child; 
end HaslL_Of; 

procedure Free (The_Node : in out Node) is 
begin 

Children.Clear(The_Node.The_ChiIdren); 
end Free; 


; I tern; 

: Children.Map; 
; Tree; 


procedure Construct (The^Item : 

And_The_Tree 
Nuinber_Of_Chi Idren ; 
On^The^Child : 

Teniporary_Node : Tree; 
begin 

if Number_Of_ChiIdren = 0 then 
if And_The_Tree = null then 

AncLThe_Tree Nodejlanager .New_Item; 
And_The_Tree.The_Item := The_Item; 
else 

raise Tree_Is_Not^ull; 
end if; 

elsif Onjrhe_Child > Number_Of_Children then 
raise Child_Error; 

else 


in I tern; 

in out Tree; 
in Natural; 

in Natural) 


is 


Tenporary_Node ;= Node_Manager.New_Item; 
TeiiporaryJNode.The_Item := The_Item; 
for Index in 1 .. Number_Of_ChiIdren loop 
if Index = On_The_Child then 
Children.Bind 

{The_Domain => Index, 

AncLThe_Range => And_The_Tree, 

In_The„Map => TertporaryJJode.The^Children) ; 

else 


ChiIdren.Bind 

(The_Domain => Index, 

And_The_Rcuige => null, 

In_The_Map => Temper aryJJode .The_Chi Idren) ; 

end if; 
end loop; 

And_The_Tree : = TeiTporary_Node ; 
end if; 
exception 

when Storage_Error | ChiIdren.Overflow => 
raise Overflow; 
end Construct; 


procedure Set_Ne3Ct (The_Node : in out Node; 

To_Next : in Tree) is 

begin 

The_Node.Next := To^Next; 
end Set_Next; 

function Next_Of (The_Node : in Node) return Tree is 
begin 

return TheJJode.Next; 
end Next_Of; 

package Node_Manager is new StorageJM[anager_Sequential 

(Item => Node, 

Pointer => Tree, 

Free => Free, 

Set_Pointer => SetJtJext, 
Pointer_Of => Next_0f); 

procedure Copy (Froin_The_Tree ; in Tree; 

To_The_Tree : in out Tree) is 

procedure Copy_Child (The_Domain : in Positive; 

The_Range : in Tree; 

Continue : out Boolean) is 

Teinporary_Node : Tree; 
begin 

Copy (The^Range, To_The_Tree => TemporaryJHode); 

Children. Bind (The_Doinain, TemporaryJlode, 

In_The_Map => To_The„Tree.The_Children) ; 
Continue := True; 
end Copy_Child; 

procedure Copy_Children is new Children.Iterate(Copy_Child); 
begin 

Clear(To_The_Tree); 
if FroirL_The_Tree /= null then 

To_The_Tree := Node_Manager.New_Item; 

To^The_Tree.The_Item := FroirL_The^Tree.The_Item; 

Copy_ChiIdren (FronL.The_Tree.The_CbiIdren) ; 
end if; 
exception 

when Storage_Error } Children.Overflow => 
raise Overflow; 
end Copy; 

procedure Clear (The_Tree : in out Tree) is 

procedure Clear_Child (The_Domain : in Positive; 

The_Range : in Tree; 

Continue : out Boolean) is 

Ten^Jorary^Node ; Tree := The_Range; 
begin 

Clear (Tenporary_Node) ; 

Continue := True; 
end Clear_Child; 

procedure Clear_Children is new Children.Iterate(Clear^Child); 
begin 


procedure Set_Item (Of...The_Tree : in out Tree; 

To_The_Item : in Item) is 

begin 

Of_The_Tree.The_Item := To_The_Item; 
exception 

when Constraint_Error => 
raise Tree_Is_Null; 
end Set_Item; 

procedure Swap_Child (The_Child : in Positive; 

Of_The_Tree : in out Tree; 

Ancl_The_Tree : in out Tree) is 
Temporary_Node : Tree; 
begin 

Tenporary_^ode := ChiIdren.Range_Of 

(The_Domain => The_Child, 

In_The_Map => Of_The_Tree.The_Children); 
Chi Idren. Unbind (The^Child, Of_The_Tree.The_Children); 
Children.Bind{The_Domain => The_Child, 

AndLThe_Range => And_The_Tree, 

In_The_Map => Of_The_Tree.The_ChiIdren); 
And_The_Tree := Temperary_Node; 
exception 

when Constraint_Error => 

raise Tree_Is^ull; 
when Children.Doinain_Is_JJot_Bo\ind => 
raise Child^Error; 
end Swap_Child; 

modified by Tuan Nguyen 
25 December 1995 

adding procedures to replace functions 

procedure Is_Equal (Left 

Right 
Result 

begin 

Result := Is_Equal(Left,Right); 
end Is_Equal; 

procedure Is_Null (The_Tree 

Result 

begin 

Result := Is_Null(TheJTree); 
end Is_Null; 

procedure ItenuOf (The_Tree 

Result 

begin 

Result := ItenuOf(The_Tree); 
end Item_Of; 

procedure Nun»ber^Of_Children_In (The_Tree 

Result 


; in Tree; 

: in Tree; 

: out Boolean) is 


; in Tree; 

: out Boolean) is 


; in Tree); 

: out Item) is 


: in Tree; 

: out Natural) is 
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procedure ChilcL_Of 


begin 

Result := Number^Of_ChiIdren_In(The_Tree); 
end Nurnber_Of_Children_In; 

(The_Tree : in Tree; 

The_Child : in Positive; 

Result : out Tree) is 

begin 

Result := Child_Of{The„Tree,The_Child); 

end Child_oe; 

— end of modification 

function Is^Egual (Left ; in Tree; 

Right ; in Tree) return Boolean rs 
Trees^e__Equal : Boolean True; , , 

procedure Check_Child_Equality (The^Domain : in Positive; 

The_Range : in Tree; 

Continue : out Boolean) is 

begin 

if not Is_Equal(The_Range, 

Children.Range_Of(The_Domain, 

Right.The_ChiIdren)) 

then 

Trees^Are^Equal := False; 

Continue := False; 

else 

Continue True; 
end if; 

end Check_Child_Equality; 
procedure Check_Equality is new 
Children.Iterate{Check_Child_Equality) ; 
begin 

if Left.The^Item /= Right.The_Item then 
return False; 

else 

if Children.Extent_Of(Left.The^Children) I- 

Children.Extent_Of(Right.The_Children) then 
return False; 

else 

Check_Equality(Left.The_Children); 
return Trees_^e_Equal ; 


end if; 
end if; 
exception 

when Constraint_Error => 

return (Left = Null_Tree) and (Right = Null_Tree); 
end Is_Equal; 

function IsJJull (The_Tree : in Tree) return Boolean is 
begin 

return (The_Tree = null); 
end Is_Null; 

function Item_Of (The_Tree : in Tree) return Item is 
begin 

return The_Tree.The_Iteiii; 
exception 

when Constraint_Error => 
raise Tree_ls_JIull ; 
end Item_Of; 

function Number_Of_Children_In (The^Tree : in Tree) return Natural 
is 

begin 

return Children.Extent_Of(The^Tree.The_Children); 
exception 

when Constraint_Error => 
raise Tree_Is_Null; 
end Number_Of_Children_In; 

function Child_Of (The^Tree : in Tree; 

■nie_Child : in Positive) return Tree is 

begin 

return Children.Range^Of(The_Domain => The_Child, 

InL.The_Map => The_Tree.The_Children); 

exception 

when Constraint_Error => 

raise Tree_Is^ull; 
when ChiIdren.DomainalsJNot_Bound => 
raise Child_Error; 
end Child_Of; 

end Tree_Arbi trary_Single_UnboundedJManaged; 
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TREE ARBITRARY SINGLE UNBOUNDED MANAGED 


PSDL 


TVTPE Tree.J^bi trary_Sing le.Unbounded^anaged 
SPECIFICATION 
GENERIC 

Item : PRIVATE_TyPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

FroiiL_The_Tree : Tree, 

To_The_Tree : Tree 
OUTPUT 

To_The_Tree ; Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_JIull, Child^Error 

END 

OPERATOR Clear 
SPECIFICATION 
INPUT 

The_Tree : Tree 
OUTPUT 

The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_Null, Chil(l_Error 

END 

OPERATOR Construct 
SPECIFICATION 
INPUT 

The_Item : Item, 

And_The_Tree : Tree, 

N\aitiber_Of_Children : Natural, 

On_The_Child : Natural 
OUTPUT 

And_The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_^ull, Tree_Is_Not_Null, Child^Error 

END 

OPERATOR Set_Item 
SPECIFICATION 
INPUT 

Of_The_Tree : Tree, 

To_The„Item : Item 
OUTPUT 

Of_The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is^ot_Null, Child^Error 

END 

OPERATOR Swap_Child 
SPECIFICATION 
INPUT 

The_Child : Positive, 

Of_The_Tree : Tree, 

And_The_Tree ; Tree 
OUTPUT 

Of_The_Tree : Tree, 

And_The_Tree : Tree 
EXCEPTIONS 


Overflow, Tree^Is_Null, Tree_Is_Not_Null, ChildLError 

END 

OPERATOR Is.Egual 

SPECIFICATION 

INPUT 

Left : Tree, 

Right : Tree 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Tree_IsJMull, Tree_Is_Not_Null, Child_Error 

END 

OPERATOR Is^ull 

SPECIFICATION 

INPUT 

The_Tree : Tree 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Tree_Is_^ull, Tree_IsJlot_Null, ChildLError 

END 

OPERATOR Item_Of 

SPECIFICATION 

INPUT 

The_Tree : Tree 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_IsLNot_Null, ChildLError 

END 

OPERATOR NumberLOf_Children_In 

SPECIFICATION 

INPUT 

The_Tree ; Tree 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Tree_ISLNull, TreeLlSLNot_Null, ChildLError 

END 

OPERATOR Child^Of 

SPECIFICATION 

INPUT 

The_Tree : Tree, 

TheLChild : Positive 
OUTPUT 

Result ; Tree 
EXCEPTIONS 

Overflow, TreeLls^Null, TreeLls^Not^Null, ChildLError 

END 

END 

IMPLEMENTATION ADA Tree_Arbitrary_Single_UnboundedLManaged 
END 
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TREE ARBITRARY SINGLE UNBOUNDED UNMANAGED 
ADA SPECIFICATIONS 


generic 

type Item is private; 

Expected_J^iiiriber_Of_Children : in Positive; 
package Tree,J^bitrary_Single_Unbounded^Uninanaged is 


type Tree 

is private 





Null^Tree 

: constant 

Tree ; 




procedure 

Copy 

( FronuThe_.Tre® 

in 


Tree; 



To_The_Tree 

in 

out 

Tree); 

procedure 

Clear 

(The^Tree 

in 

out 

Tree); 

procedure 

Construct 

(The^Item 

in 


Item; 



And_The_Tree 

in 

out 

Tree; 



Nuinber_Of_Children 

in 


Natural; 



On_The_Child 

in 


Natural); 

procedure 

Set_Item 

(Of_The_Tree 

in 

out 

Tree; 



To_The_Item 

in 


Item) ; 

procedure 

Swap_Child 

(The^Child 

in 


Positive; 



Of_The_Tree 

in 

out 

Tree; 



An<3LThe_Tree 

in 

out Tree); 


— modified by Tuan Nguyen 

— 25 December 1995 

— adding procedures to replace functions 



Result 

: out Item); 


procedure Nuinber_Of_Children_In 

{The_Tree 

Result 

: in Tree; 

: out Natural) 

; 

procedure ChildLOf 

(The^Tree 
The_Child : 

: in Tree; 

I in Positive; 



Result 

: out Tree); 


— end of modification 




function Is_Equal 

(Left 

Right 

; in Tree; 

; in Tree) 

return 

Boolean; 

function IsJJull 

(The_Tree 

: in Tree) 

return 

Boolean; 

function Item_Of 

(The_Tree 

: in Tree) 

return 

I tern; 

function Ntimber_Of_Children_In 

(The_Tree 

: in Tree) 

return 

Natural; 

function Child_Of 

(The_Tree 
The_Child : 

: in Tree; 

: in Positive) 

return 


Tree 7 


Overflow 

Tree_ls_Null 

Tree_Is_Not_Null 

Child_Error 


exception; 

exception; 

exception; 

exception; 


procedure Is_Equal 

procedure Is_Null 
procedure ItenuOf 


(Left 
Right 
Result 
(The_Tree 
Result 
(The_Tree 


in Tree; 
in Tree; 
out Boolean); 
in Tree; 
out Boolean); 
in Tree); 


private 

type Node; 

type Tree is access Node; 

Null_Tree : consteint Tree := null; 
end Tree,JVrbitrary_Single_Unbounded_Unmanaged; 
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TREE ARBITRARY SINGLE UNBOUNDED UNMANAGED 


ADA IMPLEMENTATION 


— (C) Copyright 1986, 1987, 1988, 1989, 1990 Grady Booch 

— All Rights Reserved 

— Serial Number 0100219 

•Restricted Rights Legend" 

— Use, duplication, or disclosure is subject to 

— restrictions as set forth in subdivision (b) (3) (ii) 

— of the rights in Technical Data cuid Computer 

— Software Clause of FAR 52.227-7013. Manufacturer: 

— Wizard software, 2171 S. Parfet Court, Lakewood, 

— Colorado 80227 (1-303-987-1874) 

with Map_Siirple_Noncached„Sequential_Unbounded_Unmanaged„Iterator ; 
package body Tree_Arbitrary_Single_Unbounded_Unmanaged is 

function Hash_0f (The^Child : in Positive) return Positive; 


package Children is new 

Map_Simple_NoncachedLSequential_Unbounded_Unmanaged_Iterator 
(Domain => Positive, 

Ranges => Tree, 

Number_Of_Buckets »> ExpectecLNuniber_Of_Children, 

Hash_0f => Hasbrof); 

type Node is 
record 

The_It€m ; Item; 

The_Children : Children.Map; 
end record; 

function Hash_Of (The_Child : in Positive) return Positive is 
begin 

return The_Child; 
end Hash_Of; 


procedure Copy (From_The_Tree : in Tree; 

To_The_Tree : in out "^ee) is 

procedure Copy_Child (The^Domain : in Positive; 

The_Ramge : in Tree; 

Continue ; out Boolean) is 

Temporary_Node : Tree; 
begin 

Copy(The_Range, To_The_Tree => TenporaryJMode) ; 

ChiIdren.Bind(The_Domain, Tenporary_Node, 

In_The_Map => To_The_Tree.The_Children) ; 
Continue := True; 
end Copy^Child; 

procedure Copy„Children is new Children.Iterate(Copy_Child); 
begin 

if Froin_The_Tree = null then 
To_The_Tree := null; 

else 

To_The_Tree ;= new Node; 

To_The_Tree.The_Item := From_The_Tree.The_Item; 

Copy_ChiIdren(From_The_Tree.The_ChiIdren); 
end if; 
exception 

when Storage_Error } ChiIdren.Overflow => 
raise Overflow; 
end Copy; 


procedure Clear (The_Tree : in out Tree) is 
Isegin 

The_Tree ;= null; 
end Clear; 


procedure Construct (The_Item : in Itern; 

AncLThe^Tree : in out Tree; 

Number_Of_Children : in Natural; 

On_The_Child ; in Natural) 

Teiiporary_Node : Tree ; 
loegin 

if Number_Of_ChiIdren = 0 then 
if AndLThe_Tree = null then 
And_The_Tree := new Node; 
And_The^Tree.The_Item := The_Item; 


return; 

else 

raise Tree_IsJ6lot_JJull; 
end if; 

elsif On_The_Child > Number^Of.Children then 
raise Child.Error; 

else 

Temporary.Node := new Node; 

Tenporary_>Iode. The.I tem : = The.I tern; 
for Index in 1 .. Number.Of.Children loop 
if Index = On.The.Child then 
ChiIdren.Bind 

(The.Domain => Index, 

And.The.Range => And_The.Tree, 

In.TheJtep => Temperary_Node.The.ChiIdren) ; 

else 


ChiIdren.Bind 

(The.Domain ==> 
And^TheJRange => 
In_The_Map => 


Index, 

null, 

TerrporaryJMode.The.Children); 


end if; 
end loop; 

And.The.Tree := Teinporary_JIode; 
end if; 
exception 

when Storage.Error | Children.Overflow => 
raise Overflow; 
end Construct; 

procedure Set.Item (Of.The.Tree : in out Tree; 

To.The.Item : in Item) is 

begin 

Of.The_Tree.The.Item := To.The.Item; 
exception 

when Constraint.Error =:> 
raise Tree.Is_Null; 
end Set.Item; 

procedure Swap.Child (The.Child : in Positive; 

Of.The.Tree : in out Tree; 

And.The.Tree ; in out Tree) is 
Tenporary.Node : Tree; 
begin 

TemporaryJMode := Children.Range.Of 

(The.Domain => The.Child, 

In.TheJIap => Of.The.Tree.The.ChiIdren) 
Chi Idren. Unbind (The.Chi Id, Of.The.Tree.The.Children) ; 

ChiIdren.Bind(The.Domain => The.Child, 

And.The.Range :=> And.The.Tree, 

In_TheJMap => Of.The.Tree.The.Children); 
And.The.Tree : = Tentporary.Node; 
exception 

when Constraint.Error => 

raise Tree.IsJIull; 
when Children.Domain.IsJJot.Boimd => 
raise Child.Error; 
end Swap.Child; 

— modified by Tuan Nguyen 

— 25 December 1995 

— adding procedures to replace functions 

procedure Is.Equal (Left 

Right 
Result 

begin 

Result Is.Equal(Left,Right); 

end Is.Equal; 

procedure IsJIull (The.Tree 

Result 

begin 

Result := Is.Null(The.Tree); 
end Is.Null; 

procedure Item.0f (The.Tree 

Result 

begin 

Result ;= Item.Of(The.Tree); 
end ItenuOf; 

procedure Number_Of_Children.In (The.Tree 

Result 

begin 

Result := Number.Of.Children.In(The.Tree}; 
end Nuniber.Of.Children.In; 

procedure ChildjOf (The.Tree : in Tree; 

The.Child : in Positive; 

Result : out Tree) is 

begin 

Result := Child.Of(The.Tree,The.ChiId); 
end Child.Of; 

— end of modification 


: in Tree; 

: in Tree; 

: out Boolean) is 


: in Tree; 

: out Boolecui) is 


: in Tree); 

; out Item) is 


: in Tree; 

: out Natural) is 


function Is.Equal (Left : in Tree; 

Right : in Tree) return Booleeui is 
Trees_Are.Equal : Boolean := True; 

procedure Check.Child_Equality (The.Domain : in Positive; 

The.Range : in Tree; 

Continue : out Boolean) is 


begin 

if not Is.Equal{The.Range, 

Children.Range.Of(The.Domain, 

Right.The.ChiIdren)) 

then 

Trees.Are.Equal := False; 

Continue := False; 

else 

Continue :« True; 
end if; 

end Check.Child.Equality; 
procedure Check.Equality is new 
Children.Iterate(Check.Child.Eguality); 
begin 

if Left .The.Item /= Right .The.Item then 
return False; 
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if Children.Extent_Of(Left.The_Children) /= 
Children,Extent_Of(Right.The_Children) then 
return False; 

else 

Check_Equality(Left.The_Children); 
return Trees_^e_Equal; 
end if; 
end if; 
exception 

when Constraint_Error => 

return (Left = Null_Tree) and (Right = Null^Tree); 
end Is_Equal; 

function IsJ^ull (The_Tree : in Tree) return Boolean is 
begin 

return (The^Tree null); 
end Is_JNull; 

function ItenuOf (The_Tree : in Tree) return Item is 
begin 

return The_Tree.The_Item; 
exception 

when Constraint_Error => 
raise Tree_Is_Null; 


end ItenuOf; 

fjunction Nuinber_Of_Children_In (The^Tree : 
is 

begin 

return Children.Extent_Of(The_Tree.The_ 
exception 

when Constraint„Error => 
raise Tree_Is_Null; 
end Nuinber_Of_,Children_In; 

function Child^Of (The_Tree : in Tree; 

The^Child : in Positive) 

begin 

return Children.Range_Of{The_Doinain => 
In^The_Map => 

exception 

when Constraint_Error => 

raise Tree_Is_Null; 
when Children.Doinain_IsJWot_Bound => 
raise Child_Error; 
end Child_Of; 

end Tre e_^bi trary_S ing le_UnboundecLUnmanaged ; 


in Tree) return Natural 
.Children) ; 

return Tree is 
The_Child, 

The_Tree. The_Children) ; 
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TREE ARBITRARY SINGLE UNBOUNDED UNMANAGED 


TYPE Tree_Arbitrary_Single_UnboundedLUnmanaged 
SPECIFICATION 
GENERIC 

Item ; PRIVATE_TYPE 
OPERATOR Copy 
SPECIFICATION 
INPUT 

Fron\_The_Tree ; Tree, 

To_The_Tree : Tree 
OUTPUT 

To_The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_IsJ^ot_Null, ChilcLError 

END 


OPERATOR Clear 
SPECIFICATION 
INPUT 

The^Tree : Tree 
OUTPUT 

The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_NotJNull, Child_Error 

END 


OPERATOR Construct 
SPECIFICATION 
INPUT 

The_ltem : Item, 

And_The„Tree : Tree, 

Number_Of_Children : Natural, 

On_The_Child : Natural 
OUTPUT 

And^The_Tree : Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_Null, Child^Error 

END 


OPERATOR Set_Item 
SPECIFICATION 
INPUT 

Of_The_Tree : Tree, 

To_The_Item : Item 
OUTPUT 

Of_The_Tree ; Tree 
EXCEPTIONS 

Overflow, Tree_IsJNull, Tree_Is_Not_Null, Child_Error 

END 

OPERATOR Swap^Child 
SPECIFICATION 
INPUT 

The_Child ; Positive, 

Of_The_Tree : Tree, 

And^The_Tree : Tree 
OUTPUT 

Of_The_Tree : Tree, 

And_The_Tree : Tree 
EXCEPTIONS 


PSDL 


Overflow, Tree^Is^ull, Tree_Is_JNot^ull, Child_Error 

END 


OPERATOR Is_Equal 
SPECIFICATION 
INPUT 

Left : Tree, 

Right : Tree 
OUTPUT 

Result : Boolean 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_Null, ChilcLError 

END 


OPERATOR Is_Null 
SPECIFICATION 
INPUT 

The_Tree ; Tree 
OUTPUT 

Result ; Boolean 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_NotJMull, ChildLError 

END 


OPERATOR ItenuOf 

SPECIFICATION 

INPUT 

The_Tree : Tree 
OUTPUT 

Result : Item 
EXCEPTIONS 

Overflow, Tree_IsJNull, Tree_Is_NotJNull, Child-Error 

END 

OPERATOR Nxamber_Of_Children_In 

SPECIFICATION 

INPUT 

The^Tree : Tree 
OUTPUT 

Result : Natural 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_ls_Not_Null, Chil<L.Error 

END 

OPERATOR Child_Of 

SPECIFICATION 

INPUT 

The_Tree : Tree, 

The_Child : Positive 
OUTPUT 

Result ; Tree 
EXCEPTIONS 

Overflow, Tree_Is_Null, Tree_Is_Not_Null, Child-Error 

END 

END 

IMPLEMENTATION ADA Tree-Arbitrary_Single_Unbounded-Unmanaged 
END 
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